Tabellen zusammenführen, erste Zeile bleibt leer
30.08.2019 14:12:37
Roman
verwende folgenden Code, um bestimmte Tabellenblätter auf einem neuen Tabellenblatt zusammen zu führen. Nach etwas rumprobieren funktioniert das auch super. Das einzige Problem momentan ist, dass nach dem Einfügen der Daten immer die erste Zeile leer bleibt.
Habe das mit Offset versucht auszugleichen, die erste Zeile wird dann gefüllt, aber dafür fehlen dann jeweils die letzten Zeilen der kopierten Tabellenblätter bis auf die des letzten kopierten Blattes. Sehr seltsam in meinen Augen.
Vielleicht hat jemand eine Lösung?
Option Explicit
Public Sub Zusammen()
Dim wksZiel As Worksheet, wks As Worksheet
Dim loLetzte As Long, loLetzteZiel As Long
Set wksZiel = Worksheets("Fehlerdetail")
Application.ScreenUpdating = False
For Each wks In ThisWorkbook.Worksheets
Select Case wks.Name
Case "Auswertung", "LV", "Fehlerquote", "Erläuterungen", "Fehlerdetail"
'nix machen
Case Else
With wks
'Abfrage, ob in Zeile 6, Spalte 2 Inhalt ist. Wenn ja, dann...
If .Cells(6, 2) "" Then
loLetzte = wksZiel.Cells(wksZiel.Rows.Count, 2).End(xlUp).Offset(1).Row
.Range(.Cells(6, 2), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Offset(-1).Row, _
15)).Copy
'Daten einfügen in Spalte 2
wksZiel.Cells(loLetzte, 2).PasteSpecial Paste:=xlPasteValues
'Name des Tabellenblatts wird in die letzte Spalte (loLetzte, 16) eingefügt
wksZiel.Cells(loLetzte, 16).Resize(.Range(.Cells(6, 2), _
.Cells(.Cells(.Rows.Count, 2).End(xlUp).Offset(-1).Row, 15)).Rows.Count) = _
wks.Name
Application.CutCopyMode = False
End If
End With
End Select
Next wks
Set wksZiel = Nothing
End Sub