AW: Bereich kopieren
21.01.2009 09:57:41
Weis
Vielen Dank für den Ansatz, allerdings habe ich leider nicht das richtige gefragt.
Ich kopiere euch mal das ganze Makro, dass entsprechend alle Zeilen kopiert. Beginnen soll das Makro mit dem kopieren alles unterhalb der Überschriften in der Zeile 5. Allerdings soll nur der Bereich ab a6 bis j 6 zeilenweise bis keine Werte mehr vorhanden ist, kopiert werden
Irgendwie bekomme ich das mit dem, was ich hier bekommen habe, nicht ans Ziel.
Deswegen mal mein Makro, was entsprechend angepasst werden muss.
Vielen Dank schon mal vorab.
Sub anVAB()
Dim wks As Worksheet
'Application.SreenUpdating = False
Dim iRow As Integer, iRowL As Integer, iRowT As Integer
iRowL = Cells(Rows.Count, 1).End(xlUp).Row
For iRow = 1 To iRowL
Set wks = Nothing
If InStr(Cells(iRow, 1).Value, "1") Then Set wks = Worksheets("VAB1")
If InStr(Cells(iRow, 1).Value, "2") Then Set wks = Worksheets("VAB2")
If InStr(Cells(iRow, 1).Value, "3") Then Set wks = Worksheets("VAB3")
If InStr(Cells(iRow, 1).Value, "4") Then Set wks = Worksheets("VAB4")
If InStr(Cells(iRow, 1).Value, "5") Then Set wks = Worksheets("VAB5")
If InStr(Cells(iRow, 1).Value, "6") Then Set wks = Worksheets("VAB6")
If InStr(Cells(iRow, 1).Value, "7") Then Set wks = Worksheets("VAB7")
If InStr(Cells(iRow, 1).Value, "8") Then Set wks = Worksheets("VAB8")
If InStr(Cells(iRow, 1).Value, "9") Then Set wks = Worksheets("VAB9")
'... entsprechend fortsetzen
If Not wks Is Nothing Then
iRowT = wks.Cells(Rows.Count, 1).End(xlUp).Row + 1
Rows(iRow).Copy wks.Rows(iRowT)
wks.Columns.AutoFit
End If
Next iRow
Application.CutCopyMode = False
'Application.ScreenUpdating = True
End Sub