Hallo Leute. Ich will ein Script erstellen, welches die Daten in einer Excel Arbeitsmappe "Büdget-Bericht"(Es sind  Wochenberichte - kriege jede Woche einen) filtert und anschließend diese in die andere "Gesamtansicht" rüber kopiert. Diese "Büdget_Berticht" Tabelle hat mehrere Säulen, die das Script filtern soll. Dabei sollen noch mehrere Schleifen da sein, damit der Cursor nach dem eingefügen, wieder in die erste Zeile spring und diese prüft, ob die leer ist. Wenn die Zeile nicht leer ist - dann soll der Cursor so lange eine Zeile runter gehen - bis die leere Zeil eerreicht wird, wenn die leer ist - dann soll die beschrieben werden. Dabei sollten keine feste Konstanten rein wie "A10" sondern Formel, damit das Makro das nächste "Büdget-Bericht" fortlaufend in die "Gesamtansicht" übertragen kann.  Das Programm soll 2500 Zeilen runtergehen, ab da soll eine Meldung erscheinen " Fehler! Es sind keine freie Zellen vorhanden!" Das ganze soll über eine Befehlsschaltfläche laufen.

Hier ist mein Code, bitte den zu korrigieren.

Private Sub CommandButton1_Click()
'Säule Z Gesamt
Workbooks(2).Activate
Sheets("Plattformsicht").Select
     Selection.AutoFilter Field:=5, Criteria1:="=??-????-??-????????XZ", _
        Operator:=xlAnd
        ActiveSheet.Range("O20:U20").Select
        Selection.Copy
Workbooks("Makros Probe.xls").Activate
Sheets("Tabelle1").Select
Range("B10").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'Säule Z 2010
Workbooks(2).Activate
    ActiveSheet.Range("W20:AC20").Select
    Selection.Copy
    Windows("Makros Probe.xls").Activate
    Range("I10").Select
    ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'Säule A Gesamt
Range("B11").Select
Workbooks(2).Activate
'Application.CutCopyMode = False
Sheets("Plattformsicht").Select
    Selection.AutoFilter Field:=5, Criteria1:="=??-????-??-????????XA", _
        Operator:=xlAnd
        ActiveSheet.Range("O20:U20").Select
        Selection.Copy
Workbooks("Makros Probe.xls").Activate
Sheets("Tabelle1").Select
Range("B11").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'Säule A 2010
Workbooks(2).Activate
    ActiveSheet.Range("W20:AC20").Select
    'Application.CutCopyMode = False
    Selection.Copy
    Windows("Makros Probe.xls").Activate
    Range("I11").Select
    ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'Säule B Gesamt
Range("B12").Select
Workbooks(2).Activate
'Application.CutCopyMode = False
Sheets("Plattformsicht").Select
    Selection.AutoFilter Field:=5, Criteria1:="=??-????-??-????????XB", _
        Operator:=xlAnd
        ActiveSheet.Range("O20:U20").Select
        Selection.Copy
Workbooks("Makros Probe.xls").Activate
Sheets("Tabelle1").Select
Range("B12").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'Säule B 2010
Workbooks(2).Activate
    ActiveSheet.Range("W20:AC20").Select
    'Application.CutCopyMode = False
    Selection.Copy
    Windows("Makros Probe.xls").Activate
    Range("I12").Select
    ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'Säule H Gesamt
Range("B13").Select
Workbooks(2).Activate
'Application.CutCopyMode = False
Sheets("Plattformsicht").Select
    Selection.AutoFilter Field:=5, Criteria1:="=??-????-??-????????XH", _
        Operator:=xlAnd
        ActiveSheet.Range("O20:U20").Select
        Selection.Copy
Workbooks("Makros Probe.xls").Activate
Sheets("Tabelle1").Select
Range("B13").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'Säule H 2010
Workbooks(2).Activate
    ActiveSheet.Range("W20:AC20").Select
    'Application.CutCopyMode = False
    Selection.Copy
    Windows("Makros Probe.xls").Activate
    Range("I13").Select
    ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'Säule W Gesamt
Range("B14").Select
Workbooks(2).Activate
'Application.CutCopyMode = False
Sheets("Plattformsicht").Select
    Selection.AutoFilter Field:=5, Criteria1:="=??-????-??-????????XW", _
        Operator:=xlAnd
        ActiveSheet.Range("O20:U20").Select
        Selection.Copy
Workbooks("Makros Probe.xls").Activate
Sheets("Tabelle1").Select
Range("B14").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'Säule W 2010
Workbooks(2).Activate
    ActiveSheet.Range("W20:AC20").Select
    'Application.CutCopyMode = False
    Selection.Copy
    Windows("Makros Probe.xls").Activate
    Range("I14").Select
    ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'Säule V Gesamt
Range("B15").Select
Workbooks(2).Activate
'Application.CutCopyMode = False
Sheets("Plattformsicht").Select
    Selection.AutoFilter Field:=5, Criteria1:="=??-????-??-????????XV", _
        Operator:=xlAnd
        ActiveSheet.Range("O20:U20").Select
        Selection.Copy
Workbooks("Makros Probe.xls").Activate
Sheets("Tabelle1").Select
Range("B15").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'Säule V 2010
Workbooks(2).Activate
    ActiveSheet.Range("W20:AC20").Select
    'Application.CutCopyMode = False
    Selection.Copy
    Windows("Makros Probe.xls").Activate
    Range("I15").Select
    ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

    
End Sub
 

Danke im Vorraus!