Option
Explicit
Sub
Daten_importieren()
Dim
filSRC
As
Excel.Workbook
Dim
strSRC
As
String
Dim
shtTRG
As
Excel.Worksheet
Dim
lngFreieZeile
As
Long
On
Error
Resume
Next
Application.ScreenUpdating =
False
Application.EnableEvents =
False
Set
shtTRG = ThisWorkbook.Sheets(
"Zusammenfassung"
)
With
shtTRG
lngFreieZeile = .Cells(.Cells.Rows.Count, 1).
End
(xlUp).Row + 1
strSRC = Application.GetOpenFilename(
"Excel-Arbeitsmappe (*.xls),*.xls,Excel2007-Arbeitsmappe (*.xlsx),*.xlsx"
, 1,
"Importdatei auswählen..."
,
"Importdatei"
,
False
)
If
strSRC =
""
Or
strSRC =
"Falsch"
Then
Set
shtTRG =
Nothing
Application.ScreenUpdating =
True
Application.EnableEvents =
True
Exit
Sub
End
If
Set
filSRC = Application.Workbooks.Open(strSRC, ,
True
): DoEvents
.Cells(lngFreieZeile, 1) = filSRC.Sheets(1).Range(
"A1"
)
.Cells(lngFreieZeile, 2) = filSRC.Sheets(1).Range(
"B1"
)
.Cells(lngFreieZeile + 1, 1) = filSRC.Sheets(1).Range(
"A2"
)
.Cells(lngFreieZeile + 1, 2) = filSRC.Sheets(1).Range(
"B2"
)
filSRC.Close
False
Set
filSRC =
Nothing
End
With
Set
shtTRG =
Nothing
Application.ScreenUpdating =
True
Application.EnableEvents =
True
End
Sub