Exceldatei über Dialog auswählen und importieren

Geniii · 13. November 2019 um 11:56

Hallo Leute also ich bräuchte etwas Hilfe bei VBA in Excel
Also ich habe 4 ExcelDateien mit gleichen Tabellen (A2:B20 aber unterschiedlichen Inhalten, ich soll ein VorlageDokument (Zellen A12:B30)(auch excel) mit den Inhalten befüllen. Eine der 4 Exceldateien soll über einen Dialog ausgewählt und importiert werden.

Also hier habe ich schon was probiert, das Problem ist nur die Tabelle wird nicht dahin kopiert wohin ich sie haben will

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(3)

'kopieren und einfügen
Quelle.UsedRange.Copy Ziel.Cells(A12B21)
'Ziel.UsedRange = Quelle.Cells(B2C12)

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

Grüßle Geniii

Ralf_8baafd · 13. November 2019 um 11:56

Hallo!

Das ist relativ einfach:
Das Kopieren würde so gehen:

'kopieren und einfügen
Quelle.Range(„A12:B21“).Copy Destination:=Ziel.Range(„B2:C11“)

Korrekterweise achte darauf, dass beide Ranges gleich groß sind.
In deinem Code stand bei Quelle A12:B21 = 10 Zeilen
Bei Ziel dann B2:C12 = 11 Zeilen

Den Rest hast du ja schon

Gruß
Ralf

===================

R_diger_Halverscheidt · 13. November 2019 um 11:56

Sorry, aber da kann ich dir leider nicht helfen. So fit bin ich nicht in der Makroprogrammierung.
Grüße Rüdiger

zyprian · 13. November 2019 um 11:56

Sorry . da kann ich dir leider nicht weiterhelfen.
Ciao

Peter_David_McWilliams · 13. November 2019 um 11:56

versuche:

'xxx Quelle.UsedRange.Copy Ziel.Cells(A12B21)
quelle.activate
Range(„A2:B20“).select
selection.copy
ziel.activate
Range(„A12:B30“).paste

(habe ich mit der Makro-Aufnahme gemacht)
MfG
Pete

Geniii · 13. November 2019 um 11:56

Hallo Ralf,
danke dir vielmals für die schnelle Antwort, ich glaub ich stand irgendwie unter Strom, dass ich an sowas nicht gedacht hab hehe

Kann ich mich eventuell wieder an dich wenden wenn ich ein Problem habe?

Grüßle

Eugenia

Geniii · 13. November 2019 um 11:56

Hallo Peter,

Danke für dir für die schnelle Antwort.
Sollte ich noch Fragen haben zu dem Thema, kann ich mich dann auch an dich wenden ?

Viele Grüße

Eugenia

Peter_David_McWilliams · 13. November 2019 um 11:56

na klar

Geniii · 13. November 2019 um 11:56

Hallo Peter ,
ich hätte wieder ne Frage.
Also mit dem importieren klappts jetzt super. Das was noch nicht so klappen will ist das diese Daten aus der QuellDatei nur in ein Worksheet der Ziel Datei eingefügt werden.
Habe es mit allen Worksheets so wie hier probiert aber nur 2- 3 Sheets werden tatsächlich gefüllt.

'Daten in 1 Worksheet importieren
Set Quelle = ActiveWorkbook.Worksheets(1)
Set Ziel = ThisWorkbook.Worksheets(3)

'dies hab ich hinzugefügt für die anderen Sheets
Set Quelle = ActiveWorkbook.Worksheets(1)
Set Ziel = ThisWorkbook.Worksheets(4)
Set Quelle = ActiveWorkbook.Worksheets(1)
Set Ziel = ThisWorkbook.Worksheets(5)
Set Quelle = ActiveWorkbook.Worksheets(1)
Set Ziel = ThisWorkbook.Worksheets(6)
Set Quelle = ActiveWorkbook.Worksheets(1)
Set Ziel = ThisWorkbook.Worksheets(7)

Danke im Voraus

Gruß Eugenia

na klar

Geniii · 13. November 2019 um 11:56

Hallo Ralf ,
ich hätte noch ne Frage.
Also mit dem importieren klappts jetzt super. Das was noch nicht so klappen will ist das diese Daten aus der QuellDatei nur in ein Worksheet der Ziel Datei eingefügt werden.
Habe es mit allen Worksheets so wie hier probiert aber nur 2- 3 Sheets werden tatsächlich gefüllt.

'Daten in 1 Worksheet importieren
Set Quelle = ActiveWorkbook.Worksheets(1)
Set Ziel = ThisWorkbook.Worksheets(3)

'dies hab ich hinzugefügt für die anderen Sheets
Set Quelle = ActiveWorkbook.Worksheets(1)
Set Ziel = ThisWorkbook.Worksheets(4)
Set Quelle = ActiveWorkbook.Worksheets(1)
Set Ziel = ThisWorkbook.Worksheets(5)
Set Quelle = ActiveWorkbook.Worksheets(1)
Set Ziel = ThisWorkbook.Worksheets(6)
Set Quelle = ActiveWorkbook.Worksheets(1)
Set Ziel = ThisWorkbook.Worksheets(7)

Viele Grüße

Eugenia

Ralf_8baafd · 13. November 2019 um 11:56

hi!

dsa würde so gehen; kompletter code:
einfach eine schleife um alle blätter in deiner zieldatei, und wenn der passende index gefunden wurde, kopieren bzw einfügen

'--------------------------------------------------------------
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)

For idx = 1 To ThisWorkbook.Sheets.Count
Select Case idx
Case 3, 4, 5, 6, 7 'hier die indexe der blätter eintragen, auf die eingefügt werden soll
Set Ziel = ThisWorkbook.Worksheets(idx)

'kopieren und einfügen
Quelle.Range(„A12:B21“).Copy Destination:=Ziel.Range(„B2:C11“)
End Select
Next idx

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
'-------------------------------------------------------------------------------

gruß
ralf

Geniii · 13. November 2019 um 11:56

Boh du bist genial, dankeschön !!!
Alles klappt super )))

Viele Grüße Eugenia

Bamberg · 13. November 2019 um 11:56

Hallo,

Also hier habe ich schon was probiert, das Problem ist nur die Tabelle wird nicht dahin kopiert wohin ich sie haben will

Wohin soll denn die Tabelle kopiert werden ?

LG Gerd

Geniii · 13. November 2019 um 11:56

Hallo Gerd
also ich möchte die Tabelle B2:C40 in eine andere ExcelDatei hochleden in die zellen A12:B50.
Mit Hilfe bin ich schon ein Stück weiter, funktioniert mittlerweile.
Aber wenn du mir noch eine andere Lösung zeigen kannst, ich freu mich.
Habs in moment so

Set Quelle = ActiveWorkbook.Worksheets(1)

For idx = 1 To ThisWorkbook.Sheets.Count
Select Case idx
Case 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17 'hier die indexe der blätter eintragen, auf die eingefügt werden soll
Set Ziel = ThisWorkbook.Worksheets(idx)

Quelle.Range(„B2“).Copy Destination:=Ziel.Range(„A12“) 'zu1
Quelle.Range(„C2:C16“).Copy Destination:=Ziel.Range(„B12:B26“)
Quelle.Range(„B17“).Copy Destination:=Ziel.Range(„A27“) 'zu2
Quelle.Range(„C17:C26“).Copy Destination:=Ziel.Range(„B27:B36“)
Quelle.Range(„B27“).Copy Destination:=Ziel.Range(„A37“) 'zu3
Quelle.Range(„C27:C36“).Copy Destination:=Ziel.Range(„B37:B46“)
Quelle.Range(„B37“).Copy Destination:=Ziel.Range(„A47“) 'zu4
Quelle.Range(„C37:C46“).Copy Destination:=Ziel.Range(„B47:B56“)
Quelle.Range(„B47“).Copy Destination:=Ziel.Range(„A57“) 'zu5
Quelle.Range(„C47:C56“).Copy Destination:=Ziel.Range(„B57:B66“)
Quelle.Range(„B57“).Copy Destination:=Ziel.Range(„A67“) 'zu6
Quelle.Range(„C57:C66“).Copy Destination:=Ziel.Range(„B67:B76“)
Quelle.Range(„B67“).Copy Destination:=Ziel.Range(„A77“) 'zu7
Quelle.Range(„C67:C76“).Copy Destination:=Ziel.Range(„B77:B86“)
Quelle.Range(„B77“).Copy Destination:=Ziel.Range(„A87“) 'zu8
Quelle.Range(„C77:C86“).Copy Destination:=Ziel.Range(„B87:B96“)
Quelle.Range(„B87“).Copy Destination:=Ziel.Range(„A97“) 'zu9
Quelle.Range(„C87:C96“).Copy Destination:=Ziel.Range(„B97:B106“)
Quelle.Range(„B97“).Copy Destination:=Ziel.Range(„A107“) 'zu10
Quelle.Range(„C97:C106“).Copy Destination:=Ziel.Range(„B107:B116“)
Quelle.Range(„B107“).Copy Destination:=Ziel.Range(„A117“) 'zu11
Quelle.Range(„C107:C116“).Copy Destination:=Ziel.Range(„B117:B126“)

End Select
Next idx

Grüßle

Eugenia

Geniii · 13. November 2019 um 11:56

PS: Es kann sein dass es mehr Felder geworden sind als ich gennant hab , also der code ist original aus meiner anwendung. )

wei_es_Karnickel_4b506f · 13. November 2019 um 11:56

Hallo,

was meinst du denn damit, dass die Daten nicht dahin kopiert werden, wo du die hinhaben willst?

Wenn alles funktioniert, nur die Position falsch ist, dann sollte man das doch über Rumprobieren an den Zellenangaben hinkriegen.

Erklär doch nochmal,wo genau das Problem liegt.

Gruß
das weiße Karnickel

Bamberg · 13. November 2019 um 11:56

Hallo Eugenia,

man könnte das etwas verkürzen, aber ansonten ist doch der Code ganz ok.

Beispiel:

_, For idx2 = 2 To 107 Step 15

Quelle.Range(„B“ & idx2).Copy Destination:=Ziel.Range(„A“ & idx + 10) 'zu1
Quelle.Range(„C“ & idx2 & „:C“ & idx2 + 14).Copy Destination:=Ziel.Range(„B“ & idx + 10)

Next idx2_

LG Gerd

Erich_Gier · 13. November 2019 um 11:56

Hi,
an deiner Frage bleibt schon Einiges unklar.

Ob du 4, 2 oder 300 Exceldateien hast, spielt hier wohl gar keine Rolle, zeigt sich nur bei der Dateiauswahl.
Im Text sprichst du davon, dass ein bestimmter Bereich (Range(„A2:B20“)) kopiert werden sollte.
Im Code wird dann aber der UsedRange kopiert, der ganz anders aussehen kann.

„die Tabelle wird nicht dahin kopiert wohin ich sie haben will“: Wohin genau willst du die Daten denn kopiert haben?

Probier mal diesen Näherungsversuch:

Option Explicit

Sub Import\_mit\_Dialog2()
 Dim wksQ As Worksheet, wksZ As Worksheet, varNam

 On Error GoTo xFehler
 ' Dialog "Datei öffnen" anzeigen
 varNam = Application.GetOpenFilename("Excel-Dateien(\*.xls),\*xls")

 If varNam = False Then ' Abbrechen falls keine Datei ausgewählt
 MsgBox "keine Datei ausgewählt", , "Abbruch"
 Else
 'MsgBox "Ausgewählte Datei: " & varNam, , ""
 Workbooks.Open Filename:=varNam ' Ausgewählte Datei öffnen
 Set wksQ = ActiveWorkbook.Worksheets(1) ' Quellblatt
 Set wksZ = ThisWorkbook.Worksheets(3) ' Zielblatt

 wksQ.UsedRange.Copy wksZ.Cells(12, 1) ' kopieren und einfügen
 ActiveWorkbook.Close ' Quellmappe schließen
 End If

xFehler:
 If Err.Number 0 Then
 MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine \_
 & "Beschreibung: " & Err.Description, vbCritical, "Fehler"
 End If
 Set wksQ = Nothing ' Speicher freigeben
 Set wksZ = Nothing
End Sub

Viel Erfolg!
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Erich_Gier · 13. November 2019 um 11:56

Nachtrag
Hi,
zwei Dinge hatte ich in meiner Antwort vergessen:

Meine Antwort kommt so spät, weil ich im Urlaub war
Was soll „Cells(A12B21)“ in deinem Code bedeuten?
VBA versucht sicher A12B21 als Namen einer Variablen zu interpretieren.

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Peter_David_McWilliams · 13. November 2019 um 11:56

ich sehe auch keine Kopier-Befehle, nur set quelle/ziel.

Du musst schon immer dazwischen:
quelle.activate
Range(„A2:B20“).select
selection.copy
ziel.activate
Range(„A12:B30“).paste
eingeben, sonst passiert gar nichts…