Paste erst ab Zeile 2
26.06.2015 16:03:07
Burghard
ich habe ein kleines Problem. Mein Makro soll aus mehreren Tabellenblättern Zellen kopieren und als laufende Liste in das Tabellenblatt "Gesamt" eintragen. Das funktioniert im Prinzip. Ich möchte allerdings, dass die Liste im Tabellenblatt "Gesamt" erst ab Zeile 2 beginnt (weil es in Zeile 1 eine Überschrift gibt). Mein Makro fügt die Daten aber immer in Zeile 1 beginnend ein.
Sub Übertrag()
Dim wks As Worksheet, arrSheets
Dim Hoehe As String
Dim Ende As Long
Dim leerzeilen As Long
letztezeile = Sheets("Gesamt").UsedRange.SpecialCells(xlCellTypeLastCell).Row
Application.ScreenUpdating = False
Sheets("Gesamt").Range("A2" & ":A" & letztezeile).Clear
arrSheets = Array("W", "R", "P", "B", "M", "D")
For Each wks In Sheets(arrSheets)
With wks
If .Cells(2, 1) "" Then
.Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).EntireRow.Copy
Sheets("Gesamt").Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial _
Paste:=xlAll
End If
End With
Next
leerzeilen = Sheets("Gesamt").UsedRange.Rows.Count
For Row = leerzeilen To 1 Step -1
If Sheets("Gesamt").Cells(Row, 1) = "" Then
Rows(Row).EntireRow.Delete
End If
Next
Columns("A:D").Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("C2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
Range("A1").Select
'letztezeile = ActiveSheet.Cells(65536, 1).End(xlUp).Row
letztezeile = Sheets("Gesamt").UsedRange.SpecialCells(xlCellTypeLastCell).Row
Ende = Sheets("Gesamt").Cells.SpecialCells(xlCellTypeLastCell).Column
Hoehe = 26
With Sheets("Gesamt").Range("A1").Resize(letztezeile, Ende)
.RowHeight = Hoehe
.VerticalAlignment = xlCenter
.WrapText = True
End With
With Sheets("Gesamt").Range("A1").Resize(letztezeile, Ende)
With .Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 15 'grau
End With
End With
Sheets("Gesamt").Columns("A:C").HorizontalAlignment = xlCenter
Application.ScreenUpdating = True
End Sub
Grüße Burghard