Danke vielmals
Harti
Sub CopyAll()
Dim rngA As Range, rngB As Range
Dim sFile As String, sPath As String
sPath = ThisWorkbook.Path & "/muster.xls"
Set rngA = ActiveSheet.Range("A1:F20")
Set rngB = ActiveSheet.Range("H5:H7")
sFile = Dir(sPath)
If sFile = "" Then
Workbooks.Add
Else
Workbooks.Open sPath
End If
rngA.Copy Range("A1")
rngB.Copy Range("H5")
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs sPath
Application.DisplayAlerts = True
End Sub