Option
Explicit
Dim
strQuelle
As
String
Sub
aktualisieren()
Dim
i
As
Long
Dim
name
As
String
With
ThisWorkbook.Worksheets(
"Name Ziel Tabellenblatt"
)
.Range(
"D9:D56"
).ClearContents
End
With
strQuelle = Application.GetOpenFilename(
"Excel,*.xl*"
)
If
strQuelle =
""
Then
Exit
Sub
Workbooks.Open Filename:=strQuelle
strQuelle = Split(strQuelle,
"\")(UBound(Split(strQuelle, "
\")))
For
i = 1
To
5
name = Workbooks(strQuelle).Worksheets(i).name
With
Workbooks(strQuelle).Worksheets(name)
.Range(
"C4:C51"
).Copy
End
With
With
ThisWorkbook.Worksheets(name)
.Range(
"D9"
).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=
False
, Transpose:=
False
End
With
Next
i
Application.CutCopyMode =
False
Workbooks(strQuelle).Close (
False
)
End
Sub