Hallöchen,
hier ist erst mal eine Teillösung. Der Code entscheidet automatisch, ob alles oder nur ein Bereich zu kopieren ist. Das funktioniert anhand der Auswahl des Quellbereiches mit oder ohne Spalte A.
Ist die lfd. Nr. in Spalte A allein oder mit weiteren Zellen ausgewählt, wird die Zeile kopiert. Fehlt die Spalte A in der Auswahl, wird nur der markierte Bereich kopiert. Als Ziel ist in jedem Fall eine Zelle in Spalte A zu wählen.
Teillösung ist es deshalb, weil Du von den 3 Zeilen eines Bereichs immer die erste Zeile dabei haben musst, damit es im Ziel korrekt ankommt. Im Ziel fülle ich im Moment immer ab der oberen Zeile eines Bereichs aus. Das müsste ich noch anpassen. Wenn Du z.B. nur die Nummer vom CoTrainer kopieren willst und nicht noch das Wort, kommt was durcheinander. Kopierst Du aber Co-Trainer und die Nummer, passt es. Kopierst Du nur Co-Trainer, passt es auch.
Code:
Sub InhalteKopieren()
'Variablendeklarationen
Dim rngS As Range, rngT As Range
'Bei Fehler weiter - tritt bei Abbrechen auf
On Error Resume Next
'Quelle abfragen - bereich mit lfd Nr waehlen!
Set rngS = Application.InputBox(Prompt:="Bitte Zelle mit lfd Nr. oder Zellen zum Kopieren " & _
"mit der Maus ausw?hlen oder deren Adresse von Hand eingeben.", _
Title:="Zellauswahl", Type:=8)
'Bei Fehler Makro verlassen
If Err.Number <> 0 Then Exit Sub
'Ziel abfragen - bereich mit lfd Nr waehlen!
Set rngT = Application.InputBox(Prompt:="Bitte die gew?nschte Zielzelle " & _
"mit der Maus ausw?hlen oder deren Adresse von Hand eingeben.", _
Title:="Zellauswahl", Type:=8)
'Bei Fehler Makro verlassen
If Err.Number <> 0 Then Exit Sub
'Wenn mix in SPalte A gewaehlt, dann Makro verlassen
If Intersect(rngT, rngT.Parent.Columns(1)) Is Nothing Then MsgBox "Falsche Auswahl": Exit Sub
On Error GoTo errorhandler
'Wenn anderswo als in Spalte A markiert wurde,
If Intersect(rngS, Columns(1)) Is Nothing Then
'Inhalt kopieren und einfuegen
rngS.Copy
rngT.Cells(1, rngS.Column).PasteSpecial Paste:=xlPasteValues
Else
'Inhalt aus Spalte A kopieren und einfuegen
rngS.Cells(1, 1).Resize(3, 1).Copy
rngT.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
'Inhalt aus Spalte B kopieren und einfuegen
rngS.Cells(1, 1).Offset(, 1).Copy
rngT.Cells(1, 1).Offset(, 1).PasteSpecial Paste:=xlPasteValues
rngS.EntireRow.Cells(2, 2).Resize(2, 1).Copy
rngT.EntireRow.Cells(2, 2).PasteSpecial Paste:=xlPasteValues
'Inhalt aus Spalte C:H kopieren und einfuegen
rngS.Cells(1, 1).Resize(3, 6).Offset(, 2).Copy
rngT.Cells(1, 1).Offset(, 2).PasteSpecial Paste:=xlPasteValues
'Inhalt aus Spalte I:K kopieren und einfuegen
rngS.Cells(1, 1).Resize(3, 3).Offset(, 8).Copy
rngT.Cells(1, 1).Offset(, 8).PasteSpecial Paste:=xlPasteValues
'Inhalt aus Spalte L:N kopieren und einfuegen
rngS.Cells(1, 1).Resize(3, 3).Offset(, 11).Copy
rngT.Cells(1, 1).Offset(, 11).PasteSpecial Paste:=xlPasteValues
'Ende Wenn anderswo als in Spalte A markiert wurde,
End If
errorhandler:
If Err.Number <> 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description
Application.CutCopyMode = False
End Sub