AW: Inhalt mehrere Arbeitsblatter automatisch in neues
07.07.2004 16:06:00
Jan
Jap, das funktioniert...komischerweise kopiert die Funktion nicht das gesamte Tabellenblatt, sondern nur immer gleichbleibende Bereiche.
Wenn Cells(65536, 1 ) gesetzt ist, kopiert er immer aus Datenblatt 1 und 2 nur den ersten Datensatz und dann ne bestimmte Menge aus Datenblättern 3-5 (aber nie gesamt)
Wenn Cells(65536, 2) gesetzt ist, kopiert er 34 Elemente aus Datenblatt 1, 31 aus Datenblatt 2 und weiter abnehmen aus Datenblatt 2-5
liegt das vielleicht an "i" ?
----
Sub KriKa_Blaupause_erstellen()
Dim i As Long
Dim q1 As Worksheet, q2 As Worksheet, q3 As Worksheet, q4 As Worksheet, q5 As Worksheet
Dim tarWks As Worksheet
'Quelldaten
Set q1 = Worksheets("Tabelle1")
Set q2 = Worksheets("Tabelle2")
Set q3 = Worksheets("Tabelle3")
Set q4 = Worksheets("Tabelle4")
Set q5 = Worksheets("Tabelle5")
'Zieltabelle wird erstellt
Set tarWks = Worksheets("Gesamt")
tarWks.Cells.ClearContents
With q1
For i = 2 To .Cells(65536, 1).End(xlUp).Row
Range(.Cells(i, 4), .Cells(i, .Cells(i, 255).End(xlToLeft).Column)).Copy Destination:=tarWks.Cells(tarWks.Cells(65536, 1).End(xlUp).Row + 1, 1)
Next i
End With
With q2
For i = 2 To .Cells(65536, 1).End(xlUp).Row
Range(.Cells(i, 4), .Cells(i, .Cells(i, 255).End(xlToLeft).Column)).Copy Destination:=tarWks.Cells(tarWks.Cells(65536, 1).End(xlUp).Row + 1, 1)
Next i
End With
With q3
For i = 2 To .Cells(65536, 1).End(xlUp).Row
Range(.Cells(i, 4), .Cells(i, .Cells(i, 255).End(xlToLeft).Column)).Copy Destination:=tarWks.Cells(tarWks.Cells(65536, 1).End(xlUp).Row + 1, 1)
Next i
End With
With q4
For i = 2 To .Cells(65536, 1).End(xlUp).Row
Range(.Cells(i, 4), .Cells(i, .Cells(i, 255).End(xlToLeft).Column)).Copy Destination:=tarWks.Cells(tarWks.Cells(65536, 1).End(xlUp).Row + 1, 1)
Next i
End With
With q5
For i = 2 To .Cells(65536, 1).End(xlUp).Row
Range(.Cells(i, 4), .Cells(i, .Cells(i, 255).End(xlToLeft).Column)).Copy Destination:=tarWks.Cells(tarWks.Cells(65536, 1).End(xlUp).Row + 1, 1)
Next i
End With
End Sub