Hallo zusammen,
mein Ziel ist es Werte aus mehreren Excel Dateien (A.xlsx, B.xlsx, ...) in meine Arbeitsmappe (Ziel.xlsx) zu kopieren, dort wird ein Wert berechnet und in eine Zelle geschrieben. Das ganze löse ich derzeit über ein Makro das erst Datei A.xlsx öffnet, die Zellen kopiert und in Ziel.xlsx einfügt. Dort wird ein Wert berechnet und in eine Zelle (E63) geschrieben. Dann wir A.xlsx geschlossen und die nächste Datei, B.xlsx geöffne, die Zellen kopiert in Ziel.xlsx eingefügt, der Wert berechnet und in eine andere Zelle (E64) geschrieben. Das ganze wiederholt sich dann, bis alle Excel files abgearbeitet sind.
Am ende habe ich eine Liste mit den berechneten Werten für jede Exceldtei, die ich in einem Graf plotte.
Mein Problem ist, dass diese Prozedur super ineffektiv ist. Gib es hier einen schnelleren Weg? Ich möchte untersuchen, wie sich der berechnete Werte der einzelnen Exceldateien (also die Grafik) ändert, wenn ich einen parameter in der Quelldatei abändere. Momentan muss der obere Prozess jedesmal durchlaufen werden.
Die Dateien A.xlsx, B.xlsx, ... sind alle gleich aufgebaut, lediglich die Werte unterscheiden sich. Es werden immer die gleichen Zellen aus A.xlsx, B.xlsx, ... in die Ziel.xlsx kopiert.
Danke für Eure Tipps!
Grüße
Uli
Mein aktueller Code ist wie folgt:
Sub CommandButton1_Click()
Dim strPfad As Variant 'Dateipfad von A.xlsx, B.xlsx, ...
Dim strPfad1 As String 'Dateipfad von A.xlsx, B.xlsx, ... als String
Dim wb As String 'Name der Ziel.xlsx
Dim name As String 'Name der aktuell ausgewählten Datei A.xlsx, B.xlsx, ...
Dim path As String 'Aktueller Pfad der Ziel.xlsx (händisch eingefügt)
Dim pasteIt1 As String 'Counter für Zelle, in die der berechnete Wert eingefügt wird
'Variablen zum sukzessiven öffnen der Dateien A.xlsx, B.xlsx, ...:
Dim fso As Object
Dim fo As Object
Dim f As Object
Dim i As Integer
i = 1
path = "C:\Users\path"
Set fso = CreateObject("Scripting.FileSystemObject")
Set fo = fso.getfolder("C:\Users\path\folder")
wb = Application.ActiveWorkbook.name
For Each f In fo.Files 'Durchläuft alle Dateien (A.xlsx, B.xlsx, ...) im Ordner "C:\Users\path\folder"
strPfad = f.path
If strPfad <> False Then
name = Dir(strPfad) 'Name der Datei (A.xlsx, B..xlsx, ...)
strPfad1 = CStr(strPfad) 'Umwandeln in String, hier nichtmehr nötig
Workbooks.Open (strPfad1) 'Öffne die erste Datei (A.xlsx, B..xlsx, ...)
'-----Kopieren der entsprechenden Zellen von A.xlsx nach Ziel.xlsx
Workbooks(name).Worksheets(1).Range("D3:D6").Copy
Workbooks(wb).Sheets("Quelle_Sheet").Range("D2:D5").PasteSpecial Paste:=xlValues
Workbooks(name).Worksheets(1).Range("D8:D9").Copy
Workbooks(wb).Sheets("Quelle_Sheet").Range("D7:D8").PasteSpecial Paste:=xlValues
Workbooks(name).Worksheets(1).Range("D11:D12").Copy
Workbooks(wb).Sheets("Quelle_Sheet").Range("D10:D11").PasteSpecial Paste:=xlValues
Workbooks(name).Worksheets(1).Range("D14:D16").Copy
Workbooks(wb).Sheets("Quelle_Sheet").Range("D13:D15").PasteSpecial Paste:=xlValues
Workbooks(name).Worksheets(1).Range("D18:D23").Copy
Workbooks(wb).Sheets("Quelle_Shee").Range("D17:D22").PasteSpecial Paste:=xlValues
Workbooks(name).Worksheets(1).Range("D25").Copy
Workbooks(wb).Sheets("Quelle_Sheet").Range("D24").PasteSpecial Paste:=xlValues
Workbooks(wb).Worksheets("Berechnungssheet").Range("C15").Copy 'Hier wird auf einem anderen Blatt in der Ziel der Wert berechnet ...
pasteIt = "E" & CStr(62 + i) 'Zelle zum eifügen der Werte
Workbooks(wb).Sheets("Quelle_Sheet").Range(pasteIt).PasteSpecial Paste:=xlValues '...und eingefügt
Workbooks(name).Close 'Schließe A.xlsx, B.xlsx,...
Else
MsgBox "Nichts ausgewählt!"
End If
i = i + 1
Next f
End Sub
|