Makro Sverweis

Sub b()
Dim WbQ As Workbook, WbZ As Workbook, WsQ As Worksheet
Dim WsZ As Worksheet, tQ As ListObject, Pfad$
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Bitte einzulesende Datei wählen..."
.AllowMultiSelect = False
If .Show  -1 Then
MsgBox "Vorgang abgebrochen!", vbInformation
Exit Sub
Else: Pfad = .SelectedItems(1)
End If
End With
Application.ScreenUpdating = False
Set WbQ = Workbooks.Open(Pfad)
Set WsQ = WbQ.Worksheets(1)
Set WbZ = Workbooks.Add(template:=xlWBATWorksheet)
Set WsZ = WbZ.Worksheets(1)
With WsQ.Range("A8").CurrentRegion.Columns(1)
.Offset(2, 1).Resize(.Rows.Count, 1).Copy
WsZ.Cells(1, 2).PasteSpecial (xlPasteValuesAndNumberFormats)
.Offset(2, 2).Resize(.Rows.Count, 1).Copy
WsZ.Cells(1, 3).PasteSpecial (xlPasteValuesAndNumberFormats)
.Offset(2, 4).Resize(.Rows.Count, 1).Copy
WsZ.Cells(1, 12).PasteSpecial (xlPasteValuesAndNumberFormats)
WsZ.Cells(2, 5).Resize(WsZ.Cells(WsZ.Rows.Count, 2).End(xlUp).Row - 1, 1) = " _
erl."
End With
With WsZ
.Activate
.Cells(1, 1) = "Test"
.Cells(1, 2) = "Test1"
.Cells(1, 3) = "Test2"
.Cells(1, 4) = "Test4"
End With
Set WbQ = Nothing: Set WbZ = Nothing: Set WsQ = Nothing
Set WsZ = Nothing: Set tQ = Nothing
End Sub