VBA streikt ab mehr als 2 Dateien?
23.06.2020 16:49:25
Alexander
ich möchte gerne per Makro aus bestimmten Tabellen bestimmte Zellen in eine zentrale Datei schreiben lassen. Das alles funktioniert mit dem was ich gebastelt habe auch schon sehr gut, nur leider funktioniert es ab mehr 2 Dateien im Code nicht mehr. :/
Hat jemand vlt eine Lösung?
Sub MWEinzelneDatenAusMehrerenDateienEinlesen()
Dim oTargetBook As Object
Dim oSourceBook As Object
Dim sDatei As String
Application.ScreenUpdating = False
Set oTargetBook = ActiveWorkbook
sDatei = "C:\Users\test\Desktop\Tabellen\Tabelle1.xlsx"
Set oSourceBook = Workbooks.Open(sDatei, False, True) 'nur lesend öffnen
oTargetBook.Sheets("Tabelle1").Range("a1").Value = _
oSourceBook.Sheets("Tabelle1").Cells(13, 2).Value
oTargetBook.Sheets("Tabelle1").Range("b1").Value = _
oSourceBook.Sheets("Tabelle1").Cells(13, 3).Value
oTargetBook.Sheets("Tabelle1").Range("c1").Value = _
oSourceBook.Sheets("Tabelle1").Cells(13, 4).Value
oTargetBook.Sheets("Tabelle1").Range("d1").Value = _
oSourceBook.Sheets("Tabelle1").Cells(13, 5).Value
oSourceBook.Close False 'nicht speichern
'Datei 2
sDatei = "C:\Users\test\Desktop\Tabellen\Tabelle2.xlsx"
Set oSourceBook = Workbooks.Open(sDatei, False, True) 'nur lesend öffnen
oTargetBook.Sheets("Tabelle1").Range("a2").Value = _
oSourceBook.Sheets("Tabelle1").Cells(13, 2).Value
oTargetBook.Sheets("Tabelle1").Range("b2").Value = _
oSourceBook.Sheets("Tabelle1").Cells(13, 3).Value
oTargetBook.Sheets("Tabelle1").Range("c2").Value = _
oSourceBook.Sheets("Tabelle1").Cells(13, 4).Value
oTargetBook.Sheets("Tabelle1").Range("d2").Value = _
oSourceBook.Sheets("Tabelle1").Cells(13, 5).Value
oSourceBook.Close False 'nicht speichern
'Datei 3
sDatei = "C:\Users\test\Desktop\Tabellen\Tabelle3.xlsx"
Set oSourceBook = Workbooks.Open(sDatei, False, True) 'nur lesend öffnen
oTargetBook.Sheets("Tabelle1").Range("a3").Value = _
oSourceBook.Sheets("Tabelle1").Cells(13, 2).Value
oTargetBook.Sheets("Tabelle1").Range("b3").Value = _
oSourceBook.Sheets("Tabelle1").Cells(13, 3).Value
oTargetBook.Sheets("Tabelle1").Range("c3").Value = _
oSourceBook.Sheets("Tabelle1").Cells(13, 4).Value
oTargetBook.Sheets("Tabelle1").Range("d3").Value = _
oSourceBook.Sheets("Tabelle1").Cells(13, 5).Value
oSourceBook.Close False 'nicht speichern
Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
MsgBox "Fertig!", vbInformation + vbOKOnly, "HINWEIS!"
Set oTargetBook = Nothing
Set oSourceBook = Nothing
End Sub