Hallo liebe Forummitglieder,
ich bin neu hier und bräuchte eure Hilfe, da ich sonst noch Wahnsinnig werde.
Und zwar habe ich folgendes Problem.
Ich möchte zwei oder auch mehrere Tabellen aus verschiedenen Tabellenblättern auf einem neuen Tabellenblatt zusammenführen (auch als neue Tabelle überschriften der Spalten sind bei alle gleich).
Das klappt auch mit dem unten stehenden Code.
Mein Problem ist jetzt nur das die ".specialCells(xlCellTypeVisible)" funktion nicht richtig funktioniert.
Beim rüber kopieren tut er das nur mit den sichtbaren Zeilen die nach der Reihe stehen z.b. Zeile 1,2,3 aber sobald Zeile 4 unsichtbar ist wegen dem Filter, werden die danach kommenden Zeilen nicht mehr mitgenommen also in diesem Beispiel Zeile 5,6,7 usw.., somit werden nur die Zeilen 1,2 und 3 übertragen und die Zeilen 5,6,7..., nicht übertragen, obwohl sie sichtbar sind.
Ich hoffe das Jemand dafür eine Lösung hat und bin für jeden Lösungsvorschlag Dankbar.
Sub Schaltfläche2_Klicken()
Dim RechWs1 As Worksheet
Dim RechWs2 As Worksheet
Dim ZielWs As Worksheet
Dim tempArr1 As Variant
Dim tempArr2 As Variant
Set RechWs1 = Sheets("GG")
Set RechWs2 = Sheets("UT")
Set ZielWs = Sheets("Gesamt Befundung")
With RechWs1
tempArr1 = .Range("A31:C57") .SpecialCells(xlCellTypeVisible)
End With
With RechWs2
tempArr2 = .Range(.Cells(31, 1), .Cells(35, 5)).SpecialCells(xlCellTypeVisible)
End With
With ZielWs
.Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 5)).Delete
.Cells(2, 1).Resize(UBound(tempArr1, 1), UBound(tempArr1, 2)) = tempArr1
.Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Resize(UBound(tempArr2, 1), UBound(tempArr2, 2)) = tempArr2
End With
End Sub