Makro zum Importieren von Daten in Excel

[Marcel1212]

Hallo Zusammen,

ich bin neu hier, und hab ein Problem mit meiner Makro Programmierung:

Ich würd gerne einen Button Programmieren, der bei klicken Daten aus einer Excel Datei in meine geöffnete importiert. Dabei soll die Excel Datei ausgewählt werden können.

Nun aber zu meinem eigentlichen Problem:
Da ich nicht weiß ob ich bei der Excel Datei, deren Daten importiert werden sollen, das Tabellenblatt("Input Airbus") oder das Tabellenblatt("Input Bombardier") brauche, soll es möglich sein dies auszuwählen .

Probier mich nun schon seit 12 Stunden, komm aber einfach nicht auf eine Lösung.

 Hoffe mir kann jemand weiterhelfen.

[Officer]

Hallo Marcel,

du könntest in einer Zelle über ein Drop-Down-Menü festlegen, welches der beiden Tabellenblätter importiert werden soll. Deinen String zum kopieren (übertragen) der Daten aus dem entsprechenden Sheet könntest Du dann dynamisch mit VBA unter Einbeziehung des gewählten Blatt-Namens zusammen bauen.

Vielleicht ist dieser Ansatz brauchbar für dich.

Gruß

Officer

[Marcel1212]

Hallo Officer,

Danke für deine schnelle Antwort.
Hört sich nicht schlecht an 

Mein Problem is ehr nur, dass ich mich dafür glaub ich zu wenig auskenn.
Ich weiß zwar was du meinst, weis aber nicht genau wie ich es Formeltechnisch umsetz.

Im Moment sieht mein Code so aus:

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(2)
Set Ziel = ThisWorkbook.Worksheets(3)

'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
 
jedoch beinhaltet dieser nicht die Auswahl des Tabellensheets.
Hab mir schon überlegt ob man nicht sagen kann satt: Set Quelle = ActiveWorkbook.Worksheets(2)
sowas wie = ActiveWorksheet. Worksheets( Range("A2")) oder so inder Art  (Also den Namen von der Zelle praktisch holen lassen...)

[Officer]

Hallo,

ich habe den Code etwas ergänzt und die Änderungen im Code kommentiert.
Unterstellt habe ich, dass die Auswahl der Imporblätter auf dem aktuellen Blatt in Zelle B10 stattfindet.

Hier der angepasste Code:

Code: Visual Basic

1. Sub Import_mit_Dialog()
2. Dim Quelle As Object, Ziel As Object
3. Dim Datei As String
4.  
5. On Error GoTo Fehler
6.  
7. 'Dialog "Datei öffnen" anzeigen
8. Datei = Application.GetOpenFilename("Excel-Dateien(*.xls),*xls")
9.  
10. 'Abbrechen falls keine Datei ausgewählt
11. If Datei = "Falsch" Then
12.   MsgBox "keine Datei ausgewählt", , "Abbruch"
13.   Exit Sub
14. End If
15.  
16. 'MsgBox "Ausgewählte Datei: " & Datei, , ""
17.  
18. 'Ausgewählte Datei öffnen
19. Workbooks.Open Filename:=Datei
20.  
21.  
22. '** Auslesen der gewählten Tabelle
23. '** Angenommen die Blatt-Auswahl "Airbus" und "Bombadier" stehen in Zelle B10
24. '** Wichtig: die Auswahl muss genauso lauten, wie die Tabellenblätter von denen kopiert werden soll
25. blatt = ActiveSheet.Range("B10").Value
26.  
27. Set Quelle = ActiveWorkbook.Worksheets(blatt) '<-- gewähltes Blatt wird definiert als Quelle, alles andere wie gehabt
28. Set Ziel = ThisWorkbook.Worksheets(3)
29.  
30. 'kopieren und einfügen
31. Quelle.UsedRange.Copy Ziel.Cells(1, 1)
32.  
33. ActiveWorkbook.Close
34.  
35. 'Speicher freigeben
36. Set Quelle = Nothing
37. Set Ziel = Nothing
38.  
39. Exit Sub
40.  
41. Fehler:
42. Set Quelle = Nothing
43. Set Ziel = Nothing
44.  
45.     MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _
46.     & "Beschreibung: " & Err.Description _
47.     , vbCritical, "Fehler"
48. End Sub
49.  
50.  

Gruß

Officer

[Marcel1212]

So, es läuft nun fast. jetzt kommt immer: Fehler Nr. 9 Index außerhalb des gültigen Bereichs. Der Code müsste jetzt ja stimmen (Kann ihn auch Debuggen)
Was könnt edie Fehlermeldung heißen?? 

[Officer]

Hi,

klar kannst Du den Code debuggen. Einfach auf die Schaltfläche debuggen klicken, damit wird die fehlerhafte Zeile angezeigt.

Ich vermute, dass die Bezeichnung des Tabellenblattes in der Quelldatei nicht stimmt.

Gruß

Officer

[Marcel1212]

Also Blatt Name passt. 

Ist vielleicht mit dem 

Blatt = ActiveSheet.Range("A1").Value

die Arbeitmappe gemeint in der Importiert wird  oder von der die Daten kommen.?
Vielleicht liegt da der Fehler??

Viele grüße

Marcel

[Marcel1212]

Ahhh.
Jetzt hab ichs. 

Blatt = ActiveSheet.Range("A1").Value
heißt, dass ich in dem zu Importierenden Sheet die eingabe machen muss111 

Wie müsste die Formulierung lauten wenn ich denn Blattnamen in die Arbeitsmappe eingeben will in der Importiert wird?

[Officer]

Hallo Marcel,

sinngemäß lautet der Befehl dann wie folgt:

 
Set Quelle = ActiveWorkbook.Worksheets(blatt) '<-- gewähltes Blatt wird definiert als Quelle, alles andere wie gehabt
Set Ziel = ThisWorkbook.Worksheets(3)

blatt = Ziel.Range("B10").Value


Beachte, dass der Befehl zum Auslesen des Blattnamensn nach der Definition von "Ziel" kommen muss.
Damit wird der Blattname aus der Zieltabelle aus Zeile B10 ausgelesen.

Gruß

Officer

[Marcel1212]

Super Danke für deine tolle Hilfe.
Hab noch die Reihenfolge abgeändert und jetzt Funktionierts einwandfrei.

Set Ziel = ThisWorkbook.Worksheets(3)

blatt = Ziel.Range("B10").Value 

Set Quelle = ActiveWorkbook.Worksheets(blatt) '<-- gewähltes Blatt wird definiert als Quelle, alles andere wie gehabt 

Danke! Danke! Danke! 

[moses90]

Hallo an Alle,

ich krame diesen Beitrag mal aus der Versenkung heraus:

Code: [Auswählen]

'** Auslesen der gewählten Tabelle
'** Angenommen die -Auswahl "Airbus" und "Bombadier" stehen in Zelle B10
'** Wichtig: die Auswahl muss genauso lauten, wie die Tabellenblätter von denen kopiert werden soll
 = ActiveSheet.Range("B10").Value
 
Set Quelle = ActiveWorkbook.Worksheets(blatt) '<-- gewähltes Blatt wird definiert als Quelle, alles andere wie gehabt
Set Ziel = ThisWorkbook.Worksheets(3)
Kann mir jemand diesen Abschnitt erklären?

Also ich möchte folgendes machen und denke, dass der Code, der von Officer gepostet wurde, eigentlich genau das macht was ich möchte:

Ich öffne eine leere Excel-Datei die das  Makro enthält. In diesem Makro soll eine weitere Excel-Datei ausgewählt sein, die geöffnet wird der komplette Inhalt kopiert wird und in der "leeren" Excel-Datei mit dem Makro soll dann der Inhalt eingefügt werden. Meine Wunschvorstellung wäre es, dass ich angeben kann, dass wenn in Spalte B2..B100 der Name "Test1" steht die komplette Zeile in eine eigene Mappe kommt. Steht in Spalte B10 zB Test2 kommen alle Einträge in Mappe Test2.

Irgendwie verzweifel ich gerade und hoffentlich kann mir jemand auf die Sprünge helfen!

Code: [Auswählen]

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 SubSo das ist mein bisheriger Code, das Problem ist noch, dass ich nicht weiß wie ich bestimmte Zeilen in eine eigene Mappe kopiere..

[Botpenner]

Hallo hab versht den Code zu nehmen leider funktioniert das durchsuchen des Blattnames nicht!

Hab in Zeile B10 Angebot reingeschrieben.
Er soll bitte diesen namen bei meiner zu kopierenden Datei suchen und das Blatt Angebot kopieren.
Es kommt immer Laufzeitfehler.

Wenn ich die Funktion (blatt) rausnehme und einen festen Wert eintrage funktioniert der import.
Mir scheint das er die funktion mit blatt nicht nehmen will.


So würde es funktionieren ohne vorher den Blattnamen in einer Zelle zu definieren, aber das möchte ich ja nicht

Code: [Auswählen]


Set Quelle = ActiveWorkbook.Worksheets(2)
Set Ziel = ThisWorkbook.Worksheets(3)


Kann jemand den richtigen code posten?