Makro...
08.07.2016 09:39:51
Michael
Hallo!
Sub a()
Dim Wb As Workbook
Dim WsQ As Worksheet
Dim WsZ As Worksheet
Set Wb = ThisWorkbook
'ggf. anpassen...
With Wb
Set WsQ = .Worksheets(2) '...VON Tabellenblatt 2
Set WsZ = .Worksheets(1) '...NACH Tabellenblatt 1
End With
With WsQ
'B2:Bx in die nächste freie Zelle A kopieren
.Range("B2:B" & .Cells(.Rows.Count, 2).End(xlUp).Row).Copy _
Destination:=WsZ.Range("A" & WsZ.Cells(WsZ.Rows.Count, 1).End(xlUp).Row + 1)
'F2:Fx in die nächste freie Zelle B kopieren
.Range("F2:F" & .Cells(.Rows.Count, 6).End(xlUp).Row).Copy _
Destination:=WsZ.Range("B" & WsZ.Cells(WsZ.Rows.Count, 2).End(xlUp).Row + 1)
'H2:Hx in die nächste freie Zelle C kopieren
.Range("H2:H" & .Cells(.Rows.Count, 8).End(xlUp).Row).Copy _
Destination:=WsZ.Range("C" & WsZ.Cells(WsZ.Rows.Count, 3).End(xlUp).Row + 1)
'AB2:ABx in die nächste freie Zelle D kopieren
.Range("AB2:AB" & .Cells(.Rows.Count, 28).End(xlUp).Row).Copy _
Destination:=WsZ.Range("D" & WsZ.Cells(WsZ.Rows.Count, 4).End(xlUp).Row + 1)
'AJ2:AJx in die nächste freie Zelle E kopieren
.Range("AJ2:AJ" & .Cells(.Rows.Count, 36).End(xlUp).Row).Copy _
Destination:=WsZ.Range("E" & WsZ.Cells(WsZ.Rows.Count, 5).End(xlUp).Row + 1)
'CA2:CAx in die nächste freie Zelle F kopieren
.Range("CA2:CA" & .Cells(.Rows.Count, 79).End(xlUp).Row).Copy _
Destination:=WsZ.Range("F" & WsZ.Cells(WsZ.Rows.Count, 6).End(xlUp).Row + 1)
End With
End Sub
Wenn Du die Quell- und Ziel-Tabellenblätter lieber mit Namen ansprechen möchtest, also nicht mit ihrer Position in der Mappe (aktuell vom Blatt 2 ins Blatt 1 kopieren), müsstest Du diesen Teil
'ggf. anpassen...
With Wb
Set WsQ = .Worksheets(2) '...VON Tabellenblatt 2
Set WsZ = .Worksheets(1) '...NACH Tabellenblatt 1
End With
mit diesem ersetzen
With Wb
Set WsQ = .Worksheets("DeinQuellblattName")
Set WsZ = .Worksheets("DeinZielblattName")
End With
LG
Michael