Hallo Werner,

Tut mir leid, dachte es wäre nicht so wichtig.

Aber gerne hier. Denke an den gelb markierten Stellen müsste die Prüfung stattfinden bzw. eingefügt werden:

Sub Übernahme()
'
' Übernahme Makro
'

'
    Sheets("Quelle_Sheet1").Select
    ActiveSheet.Range("$A$1:$JH$14").AutoFilter Field:=1, Criteria1:="<>"
    Range("A2:AL2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("Ziel_Datei.xml").Activate
    Sheets("Ziel_Datei_Sheet1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Quell_Datei.xlsm").Activate
    Sheets("Quelle_Sheet1").Select
    Range("AM2:BT2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Ziel_Datei.xml").Activate
    Sheets("Ziel_Datei_Sheet2").Select
    Range("A9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Quell_Datei.xlsm").Activate
    Sheets("Quelle_Sheet1").Select
    ActiveWindow.ScrollColumn = 57
    ActiveWindow.ScrollColumn = 58
    ActiveWindow.ScrollColumn = 59
    ActiveWindow.ScrollColumn = 60
    ActiveWindow.ScrollColumn = 61
    ActiveWindow.ScrollColumn = 62
    ActiveWindow.ScrollColumn = 63
    ActiveWindow.ScrollColumn = 64
    ActiveWindow.ScrollColumn = 65
    ActiveWindow.ScrollColumn = 66
    ActiveWindow.ScrollColumn = 67
    ActiveWindow.ScrollColumn = 68
    ActiveWindow.ScrollColumn = 69
    ActiveWindow.ScrollColumn = 70
    ActiveWindow.ScrollColumn = 71
    ActiveWindow.ScrollColumn = 72
    ActiveWindow.ScrollColumn = 73
    ActiveWindow.ScrollColumn = 74
    ActiveWindow.ScrollColumn = 75
    ActiveWindow.ScrollColumn = 76
    ActiveWindow.ScrollColumn = 77
    ActiveWindow.ScrollColumn = 78
    ActiveWindow.ScrollColumn = 79
    ActiveWindow.ScrollColumn = 80
    ActiveWindow.ScrollColumn = 81
    ActiveWindow.ScrollColumn = 82
    ActiveWindow.ScrollColumn = 83
    Range("CP2:HG2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Ziel_Datei.xml").Activate
    Sheets("Ziel_Datei_Sheet3").Select
    Range("A9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Quell_Datei.xlsm").Activate
    Sheets("Quelle_Sheet1").Select
    Range("HM2:IW2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Ziel_Datei.xml").Activate
    Sheets("Ziel_Datei_Sheet4").Select
    Range("A9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Quell_Datei.xlsm").Activate
End Sub

Gruß

DiWa