public function copyData()
Dim
fd
As
FileDialog
Dim
file
As
String
Dim
objApp, objWBSource, objWBTarget, objWSSource, objWSTarget
As
Object
Set
fd = Application.FileDialog(msoFileDialogOpen)
With
fd
.AllowMultiSelect =
False
.Title =
"Zieldatei wählen..."
.Filters.Clear
.Filters.Add
"Exceldateien"
,
"*.xls; *.xlsm"
, 1
If
.Show = -1
Then
file = .SelectedItems(1)
Else
exit function
End
If
End
With
Set
objApp = CreateObject(
"Excel.Application"
)
Set
objWBTarget = objApp.Workbooks.Open(file)
Set
objWBSource = ActiveWorkbook
Set
objWSTarget = objWBTarget.Worksheets(
"TARGET_SHEET_NAME"
)
Set
objWSSource = objWBSource.Worksheets(
"SOURCE_SHEET_NAME"
)
objWSSource.Activate
Application.CutCopyMode =
False
objWSSource.Range(
"A1:A5"
).Copy
objWSTarget.Range(
"A1"
).PasteSpecial
objWBTarget.Save
objWBTarget.Close
objWBSource.Activate
objApp.Quit
Set
objWSTarget =
Nothing
Set
objWSSource =
Nothing
Set
objWBTarget =
Nothing
Set
objWBSource =
Nothing
Set
objApp =
Nothing
Set
fd =
Nothing
end function