[SuperWolf]

Hallo zusammen,

ich möchte gern ein Excel-Marko erstellen in dem ich in ein bereits stehendes Arbeitsblatt importieren.

Die Datei wird zuvor mittels Dialog ausgewählt.

Allerdings möchte ich nicht, dass aus der Quelldatei die erste Zeile mit importiert wird und ich möchte, dass die Daten in der Zieldatei unten angefügt werden.

Ich hoffe ich habe es verständlich formuliert.

Habe mal den bisherigen Code unten angefügt.

Hoffe jemand kann mir helfen.


Danke vorab!

Gruß
Wolf

Sub Import_mit_Dialog()  
Dim Quelle As Object, Ziel As Object
Dim Datei As String

On Error GoTo Fehler

'Dialog "Datei öffnen" anzeigen
Datei = Application.GetOpenFilename("Excel-Dateien(*.xls),*xls")

'Abbrechen falls keine Datei ausgewählt
If Datei = "Falsch" Then  
  MsgBox "keine Datei ausgewählt", , "Abbruch"
  Exit Sub
End If

'MsgBox "Ausgewählte Datei: " & Datei, , ""

'Ausgewählte Datei öffnen
Workbooks.Open Filename:=Datei 

Set Quelle = ActiveWorkbook.Worksheets(1) 
Set Ziel = ThisWorkbook.Worksheets(1) 

'kopieren und einfügen
Quelle.UsedRange.Copy Ziel.Cells(1, 1) 

ActiveWorkbook.Close 

'Speicher freigeben
Set Quelle = Nothing  
Set Ziel = Nothing  

Exit Sub  

Fehler:
Set Quelle = Nothing  
Set Ziel = Nothing  

    MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _ 
    & "Beschreibung: " & Err.Description _
    , vbCritical, "Fehler"
End Sub

[SuperWolf]

Hab den Code mal angepasst, habe allerdings noch Probleme bei der Auswahl des Zielbereiches.



Jemand ne Idee?

Sub Import_PSP()
Dim Quelle As Object, Ziel As Object
Dim Datei As String

On Error GoTo Fehler

'Dialog "Datei öffnen" anzeigen
Datei = Application.GetOpenFilename("Excel-Dateien(*.xlsx),*xlsx")

'Abbrechen falls keine Datei ausgewählt
If Datei = "Falsch" Then
  MsgBox "keine Datei ausgewählt", , "Abbruch"
  Exit Sub
End If

'MsgBox "Ausgewählte Datei: " & Datei, , ""

'Ausgewählte Datei öffnen
Workbooks.Open Filename:=Datei

Set Quelle = ActiveWorkbook.Worksheets(1)
Set Ziel = ThisWorkbook.Worksheets(1)



'kopieren und einfügen
alle = Quelle.Cells(Rows.Count, 1).End(xlUp).Row
ende = Ziel.Cells(Rows.Count, 1).End(xlUp).Row

Quelle.Range("A1:M" & alle).Copy
Ziel.Paste Destination:=Ziel.Range("A" & ende :"M")


ActiveWorkbook.Close


'Speicher freigeben
Set Quelle = Nothing
Set Ziel = Nothing

Exit Sub

Fehler:
Set Quelle = Nothing
Set Ziel = Nothing

    MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _
    & "Beschreibung: " & Err.Description _
    , vbCritical, "Fehler"
End Sub