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
|