Option
Explicit
Sub
kopieren()
Application.DisplayAlerts =
False
Dim
Pfad
As
String
Dim
urdatei
Dim
freiezeile
As
Long
Dim
startdatei
Dim
quelldatei
Set
startdatei = ActiveWorkbook
freiezeile = ActiveSheet.Cells(Rows.Count, 2).
End
(xlUp).Row + 1
Set
urdatei = Worksheets(ActiveSheet.Index)
Pfad = Sheets(1).Range(
"AB48"
)
Workbooks.Open Pfad &
"\" & Sheets(1).Range("
AB49")
Set
quelldatei = ActiveWorkbook
ActiveWorkbook.Sheets(
"Tabelle1"
).Range(
"A2:M22"
).Copy startdatei.Sheets(
"Tabelle2"
).Cells(freiezeile, 1)
startdatei.Activate
quelldatei.Close savechanges:=
False
Range(
"A1"
).
Select
set startdatei = nothing
set quelldatei = nothing
Application.DisplayAlerts =
True
End
Sub