Excel VBA Weitere Datei öffnen und Daten übertragen

chris123030 · 18. November 2015

Hallo zusammen,

ich möchte in Excel realisieren, dass ich die Daten, die ich in einer Datei eingegeben habe (Quelle.xls, verschiedene Zellen A1, C17, G25 usw.) per Makro in eine andere Datei (Ziel.xls) übertragen kann. Dabei sollen die Daten stets in die nächst freie Zeile der Zieldatei übernommen werden (alle in einer Zeile hintereinander, z.B. Spalte 1-10).

Könntet Ihr mit bei dem Code helfen, der hierfür benötigt wird? Bin leider noch ziemlicher Anfänger. :-)

Vielen Dank schon mal.

Chris :-)

Mextli · 19. November 2015

Ich kann Dir nur Anhaltspunkte liefern, anpassen & finalisieren musst Du schon selber. Google ist Dein Freund, es gibt unglaublich viel VBA Hilfe im Netz.

1) Ich würde die Zellen zuerst auslesen und in Variablen zwischenpuffern.
Worksheets("Master Def").Select ' Name des Reiters aus dem wir auslesen wollen
filename = Cells(InputBox_X, InputBox_Y) ' InputBox_X & Y ist vordefiniert und gibt die Koordinaten an, der Wert der Zelle wird in die Variable filename geschrieben

2) Dann würde ich die Variablen en bloc in die Zieldatei runterschreiben, am besten mit einer Schleife.
Worksheets("Ziel Reiter").Select ' vorher muss der Ziel Reiter aktiviert werden
Cells(y, x).value = filename

chris123030 · 19. November 2015

Vielen Dank für Deine Antwort, wie müsste denn dabei der Anfang des Codes aussehen, bzgl. Dim, Integer, Object, Option explicit usw....?
Oder kann ich einfach ohne loslegen?

Danke

Mextli · 19. November 2015

Googeln & loslegen. VBA ist so ziemlich eine der schmutzigsten sprich einsteigerfreundlichsten Sprachen schlechthin. Um Variablen vor dem Programmcode zu definieren (was durchaus Sinn macht) müsstest Du erst mal wissen, was die verschiedenen Variablenformate bedeuten und welche Du für was benötigst.

chris123030 · 19. November 2015

Also mein Code sieht bis jetzt so aus:

1 Sub DatenÜbertragen()
2
3
4 Worksheets("Tabelle1").Select
5 Filename = Cells(1, 1)
6 Workbooks.Open "D:\Eigene Dateien\Ziel.xls"
7
8 Worksheets("Zieltabelle").Select
9 Cells(5, 5).Value = Filename
10
11
12 End Sub

Es gibt aber einen Laufzeitfehler 9 in Zeile 8.

cumulonimbus8 · 19. November 2015

Ich bin mir sicher, dass die Forensuche Beispiele liefert. Ich habe schon immer einen Knoten im Code gehabt wenn ich mehreren Mappen makrogesteuert jonglieren musste…

Der Erste und einfachste Rat: volle Referenzierung!
Mal als Beispiel wie das aussieht nur zwischen einzelnen Blättern ein und derselben Mappe zu kopieren (und zwar direkt):

Code:

Worksheets("Blatt4").Range(Worksheets("Blatt4").Cells(1, 12), _
Worksheets("Blatt4").Cells(21, 12)) = _
Worksheets("Blatt5").Range(Worksheets("Blatt5").Cells(1, 4), _
Worksheets("Blatt5").Cells(21, 4)).Value

Vor das Worksheets spannt du nun das Workbook (also die Mappe) - die öffnest du natürlich vorher wie du es kennst:

Code:

Workbooks("Ziel.xls").Worksheets("Zieltabelle").Cells(5.5)="Zieltabelle"

Den Value kann man beim Ziel getrost weglassen, er ist der Standard.

Das wirkt wirr, und mit SET könnte man (und immer mit ›voller Anschrift‹) sich auch das Schreiben verkürzen…

Code:

Dim Blatt As Worsheet
…
Set Blatt=Workbooks("Ziel.xls").Worksheets("Zieltabelle")
…
Blatt.Cells(5.5)="Zieltabelle"

…wichtiger ist aber, ohne .Select (in älteren VBAs .Activate) auszukommen.

Übrigens hat diese Vollreferenzierung auch den Vorzug, dass du ein einem halben Jahr noch weißt wer da konkret mit im Spiel ist. (Ich weiß wovon ich rede, seufz…)

CN8

Janush · 23. November 2015

Hallo,

wenn Du uns kurz mitteils wie genau deine Quelldatei aufgebaut ist und wie deine Zieltabelle, kann man bestimmt besser helfen. Ich kann mir bisher noch nicht vorstellen wie Quelle.xls aussieht.

mfg

chris123030 · 24. November 2015

Hallo,

also ich hab mal zur Verdeutlichung ein Paar Fotos gemacht:

Quelle.xlt

Ziel.xls

Quelle.xlt ist eine Vorlage, auf deren Basis diverse Dokumente erstellt werden. Die für mich relevanten Zellen sind über das Dokument verteilt, jedoch immer an der gleichen Stelle.
Ziel.xls fungiert als eine Art Datenbank, in die die Zellinhalte aus Quelle.xlt per Makro kopiert werden sollen. Diese sollen dabei wie im Bild gezeigt alle in einer Zeile stehen. Bei Übertragung eines neuen "Datensatzes" aus einem Quell-Dokument sollen die Zellinhalte in die jeweils nächste freie Zeile übernommen werden.

Ich hoffe es ist in etwa klar was ich meine :-)

Vielen Dank.
Ich versuche mich in der Zwischenzeit schon mal weiter am Code.

cumulonimbus8 · 24. November 2015

So viel auf die Schnelle: ohne eine Tabelle (bitte nicht missverstehen) die angibt welche Quellzelle zu welcher Zielzelle (ich rate mal: vornehmlich Zielspalte) werden muss kommst du nicht aus.

Wenn weiterhin die Quelldateien anders heißen - ich mutmaße munter drauflos - muss die Zielmappe (Sammel-Mappe) die relevanten Makros enthalten. Darunter eines das eine Öffnen-Dialog auslöst ab dem es im Grunde automatisch ablaufen kann: aufmachen, kopieren, zumachen [ohne Speichern], Sammel-Mappe speichern. (Freaks bauen ein Häkchen ein ob dann auch die Sammel-Mappe sich dezent zurückziehen möge.)

Entspricht das en gros deinem Szenario?

CN8

chris123030 · 24. November 2015

So ich hab das Ganze jetzt mal wie folgt gelöst:

Sub DatenÜbertragen()

Dim erste_freie_Zeile As Integer

Workbooks.Open "D:\Eigene Dateien\Excel an Excel\Ziel.xls"

erste_freie_Zeile = Workbooks("Ziel.xls").Worksheets("Zieltabelle").Range("A65536").End(xlUp).Offset(1, 0).Row

Worksheets("Tabelle1").Cells(15, 3).Copy Destination:=Workbooks("Ziel.xls").Worksheets("Zieltabelle").Cells(erste_freie_Zeile, 1)
Worksheets("Tabelle1").Cells(13, 3).Copy Destination:=Workbooks("Ziel.xls").Worksheets("Zieltabelle").Cells(erste_freie_Zeile, 2)
Worksheets("Tabelle1").Cells(21, 3).Copy Destination:=Workbooks("Ziel.xls").Worksheets("Zieltabelle").Cells(erste_freie_Zeile, 3)
Worksheets("Tabelle1").Cells(23, 3).Copy Destination:=Workbooks("Ziel.xls").Worksheets("Zieltabelle").Cells(erste_freie_Zeile, 4)
Worksheets("Tabelle1").Cells(13, 6).Copy Destination:=Workbooks("Ziel.xls").Worksheets("Zieltabelle").Cells(erste_freie_Zeile, 5)
Worksheets("Tabelle1").Cells(15, 6).Copy Destination:=Workbooks("Ziel.xls").Worksheets("Zieltabelle").Cells(erste_freie_Zeile, 6)
Worksheets("Tabelle1").Cells(25, 3).Copy Destination:=Workbooks("Ziel.xls").Worksheets("Zieltabelle").Cells(erste_freie_Zeile, 7)
Worksheets("Tabelle1").Cells(25, 6).Copy Destination:=Workbooks("Ziel.xls").Worksheets("Zieltabelle").Cells(erste_freie_Zeile, 8)
Worksheets("Tabelle1").Cells(19, 3).Copy Destination:=Workbooks("Ziel.xls").Worksheets("Zieltabelle").Cells(erste_freie_Zeile, 9)
Worksheets("Tabelle1").Cells(17, 6).Copy Destination:=Workbooks("Ziel.xls").Worksheets("Zieltabelle").Cells(erste_freie_Zeile, 10)
Worksheets("Tabelle1").Cells(28, 4).Copy Destination:=Workbooks("Ziel.xls").Worksheets("Zieltabelle").Cells(erste_freie_Zeile, 11)
Worksheets("Tabelle1").Cells(17, 3).Copy Destination:=Workbooks("Ziel.xls").Worksheets("Zieltabelle").Cells(erste_freie_Zeile, 12)
Worksheets("Tabelle1").Cells(57, 1).Copy Destination:=Workbooks("Ziel.xls").Worksheets("Zieltabelle").Cells(erste_freie_Zeile, 13)

End Sub

Funktioniert auch so weit wunderbar wie ich es mir gewünscht hab.

Ich hab nur noch das Problem, dass die Formatierung mit übernommen wird.
Wie kann ich denn nur die Werte in die Zieldatei übernehmen?

Vielen Dank :-)

Janush · 25. November 2015

Hab mal was passendes zu deinen Angaben gebastelt. Das schreibt die Daten in Dein Zielfile ohne das Du es oeffnen musst. Zwar weiss ich nicht wie der Tabellenkopf in deinem Zielfile aussieht, aber ich habe mal Name1 bis Name13 angenommen. Wenn das nicht passt, musst Du die Referenzen noch anpassen.

Um es ganz bequem zu halten kannst Du diesen Code auf in ein AddIn verwandeln und dann immer nur einen Knopf in deiner Toolbar druecken

Bitte noch darauf achten die Microsoft ActiveX Data Objects x.x Library einzubinden. Happy coding.

Code:

Sub DatenÜbertragen()
Dim mySQL As String

'benoetig "Microsoft ActiveX Data Objects x.x Library" referenz
Dim cN As ADODB.Connection
Dim rs As ADODB.Recordset
Set cN = New ADODB.Connection
Set rs = New ADODB.Recordset

Dim path As String
Dim valueStr As String

'legt den Zielpfad fest
path = "D:\Eigene Dateien\Excel an Excel\Ziel.xls"

'liest die Daten aus dem Quellfile in einen Textstring
valueStr = "'" & Worksheets("Tabelle1").Cells(15, 3) & "', '"
valueStr = valueStr & Worksheets("Tabelle1").Cells(13, 3) & "', '"
valueStr = valueStr & Worksheets("Tabelle1").Cells(21, 3) & "', '"
valueStr = valueStr & Worksheets("Tabelle1").Cells(23, 3) & "', '"
valueStr = valueStr & Worksheets("Tabelle1").Cells(13, 6) & "', '"
valueStr = valueStr & Worksheets("Tabelle1").Cells(15, 6) & "', '"
valueStr = valueStr & Worksheets("Tabelle1").Cells(25, 3) & "', '"
valueStr = valueStr & Worksheets("Tabelle1").Cells(25, 6) & "', '"
valueStr = valueStr & Worksheets("Tabelle1").Cells(19, 3) & "', '"
valueStr = valueStr & Worksheets("Tabelle1").Cells(17, 6) & "', '"
valueStr = valueStr & Worksheets("Tabelle1").Cells(28, 4) & "', '"
valueStr = valueStr & Worksheets("Tabelle1").Cells(17, 3) & "', '"
valueStr = valueStr & Worksheets("Tabelle1").Cells(57, 1) & "'"

'stellt eine Verbindung zum Zielfile her
cN = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
               "Data Source= " & path & ";" & _
               "Extended Properties=""Excel 12.0; HDR=Yes"""
cN.Open

'schreibt die Daten aus dem Textstring in das Zielfile.
'Tabellen header muessen mit den Values im SQL string ueberein stimmen

mySQL = "INSERT INTO [Zieltabelle$] (Name1, Name2, Name3, Name4, Name5, Name6, Name7, Name8, Name9, Name10, Name11, Name12, Name13) " & _
                        "VALUES (" & valueStr & ");"
                        
rs.Open mySQL, cN, adOpenDynamic, adLockOptimistic

'aufraeumen
cN.Close
Set cN = Nothing
Set rs = Nothing
End Sub

cumulonimbus8 · 25. November 2015

Ich hab nur noch das Problem, dass die Formatierung mit übernommen wird.
Wie kann ich denn nur die Werte in die Zieldatei übernehmen?

Lies mal ganz weit unten

Dim erste_freie_Zeile As Integer
Könnte in die Hose gehen wenn du mehr Zeilen als 32768 hast

Code:

Sub DatenÜbertragen()
Dim ErsteFreieZeile As Long
Dim QuellBereichZeile As Variant
Dim QuellBereichSpalte As Variant
Dim I As Integer
 QuellBereichZeile = Array(15, 13, 21, 23, 13, 15, 25, 25, 19, 17, 28, 17, 57)
 QuellBereichSpalte = Array(3, 3, 3, 3, 6, 6, 3, 6, 3, 6, 4, 3, 1)
 ErsteFreieZeile = Worksheets("Zieltabelle").Cells(Rows.Count, 2).End(xlUp).Row
 Workbooks.Open "D:\Eigene Dateien\Excel an Excel\Quelle.xls"
 For I = 1 To UBound(QuellBereichZeile)
  Cells(ErsteFreieZeile, I) = _
   Workbooks("Quelle.xls").Worksheets("Tabelle1").Cells(QuellBereichZeile(I), QuellBereichSpalte(I))
 Next
 Workbooks("Quelle.xls").Close True
 ThisWorkbook.Save
End Sub

Probier doch mal ob das klappt. Die Arrays sollen hier die von mir angesprochene Tabelle definieren aus der sich bedient wird.
Wichtig ist, dass ich alles Copy und Destination losgeworden bin. Ich mags nicht weils die Zwischenablage beeinflusst. Außerdem geht mit meiner Methode bewusst jede Formatierung flöten, das wolltest du ja.

CN8

chris123030 · 27. November 2015

Wollte mich nur noch bedanken für Eure Anregungen, jetzt läuft alles ohne Probleme. :-)

Suche

Excel VBA Weitere Datei öffnen und Daten übertragen

chris123030

Cadet 2nd Year

Mextli

Commander

chris123030

Cadet 2nd Year

Mextli

Commander

chris123030

Cadet 2nd Year

cumulonimbus8

Fleet Admiral

Janush

Lieutenant

chris123030

Cadet 2nd Year

cumulonimbus8

Fleet Admiral

chris123030

Cadet 2nd Year

Janush

Lieutenant

cumulonimbus8

Fleet Admiral

chris123030

Cadet 2nd Year

Ähnliche Themen