Thema Datum  Von Nutzer Rating
Antwort
Rot Zellen aus mehreren Exceldateien effizient in Mappe kopieren
 11.04.2019 08:45:12 Uli
NotSolved
11.04.2019 09:41:36 Flotter Feger
NotSolved
11.04.2019 09:51:26 Uli
NotSolved
11.04.2019 11:02:39 Flotter Feger
Solved

Ansicht des Beitrags:
Von:
Uli		 Datum:
11.04.2019 08:45:12		 Views:
1054		 Rating:
     
Antwort:
  Ja
Thema:
Zellen aus mehreren Exceldateien effizient in Mappe kopieren

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:

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
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

 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Zellen aus mehreren Exceldateien effizient in Mappe kopieren
 11.04.2019 08:45:12 Uli
NotSolved
11.04.2019 09:41:36 Flotter Feger
NotSolved
11.04.2019 09:51:26 Uli
NotSolved
11.04.2019 11:02:39 Flotter Feger
Solved