Office: Automatisches Kopieren aus anderer,variabler Datei

Hallo Zusammen,
ich muss in eine Tabelle Zahlen reinkopieren, die sich in verschiedenen anderen Tabellen befinden.
Kleines Bild dazu im Anhang.
Es gibt eine Ordnerstruktur, die die Ordner mit den Namen HG,SR,... (quasi alle Namen, die ab D3 auf dem Bild aufgelistet werden) enthält.
Jeder Ordner erhält ExcelDateien mit den Namen 40.xls, 41.xls, ... (quasi die Namen aus E1, F1,...)

Jetzt das Problem:
Die Zelle E3 soll den Wert bekommen, der in der Datei 40.xls (also quasi "E1".xls) aus dem Ordner HG (also "D3")
usw. und das am besten unkompliziert :D

Ich habe folgende Vorüberlegungen gemacht:
i und j als Variable definieren
i als die Variable für Zeilen
j als die Variable für Spalten
öffne für Zelle ij
den ordner dj
und darin die Datei i1
und kopiere die Zelle "E"j in dieser Datei (Es wird immer aus der Spalte E herauskopiert und nicht aus der i-ten Spalte)
und füge sie an der Stelle ij in der Ausgangsdatei ein.



Mein Problem ist das ganze vba tauglich zu definieren und umzusetzen.
Könnte mir jemand dabei etwas helfen?
Liebe Grüße
Anna

 

Hallo Anna,

wenn ich alles richtig verstanden habe, dann sollte der folgende Code prinzipiell funktionieren:

Code:

Option Explicit

Public Sub AutomatischesKopieren()

Dim loRow As Long
Dim loColumn As Long
Dim loLastRow As Long
Dim loLastColumn As Long

Dim strPfad As String
Dim strOrdner As String
Dim strDatei As String

Dim wbQuelle As Workbook

strPfad = "hier kommt der Pfad zum Überordner der Ordnerstruktur hin"
    With Me
        loLastRow = IIf(IsEmpty(.Cells(.Rows.Count, 4)), .Cells(.Rows.Count, 4).End(xlUp).Row, .Rows.Count)
        loLastColumn = IIf(IsEmpty(.Cells(1, .Columns.Count)), .Cells(1, .Columns.Count).End(xlToLeft).Column, .Columns.Count)
        For loRow = 3 To loLastRow
            strOrdner = .Cells(loRow, 4)
            If Not strOrdner = "" Then
                If Not Dir(strPfad & "\" & strOrdner & "\") = "" Then
                    For loColumn = 5 To loLastColumn
                        strDatei = .Cells(1, loColumn)
                        If Not strDatei = "" Then
                            If Not Dir(strPfad & "\" & strOrdner & "\" & strDatei & ".xls") = "" Then
                                Set wbQuelle = Workbooks.Open(strPfad & "\" & strOrdner & "\" & strDatei & ".xls")
                                wbQuelle.Sheets(1).Cells(loColumn, 5).Copy Destination:=.Cells(loRow, loColumn)
                                wbQuelle.Close SaveChanges:=False
                                Set wbQuelle = Nothing
                            End If
                        End If
                    Next loColumn
                End If
            End If
        Next loRow
    End With
End Sub

ACHTUNG!!! Folgendes ist zu beachten:

- Die Zeile "With Me"
referenziert den Code auf das Blatt, in dessen Modul der Code steht. Schreibst Du den Code in ein anderes (z.Bsp. ein allgemeines) Modul, dann musst Du diese Referenzierung ändern.

- Die Zeile "strPfad = "hier kommt der Pfad zum Überordner der Ordnerstruktur hin""
muss von Dir noch angepasst werden. Der Pfad des Überordners, wo die ganzen Ordner aus der Spalte D drinne sind, muss dort eingetragen werden, und zwar in Gänsefüsschen, vom Laufwerksbuchstaben an, bis zum Namen des Überordners, aber OHNE Backslash am Ende.
Z.Bsp:

Code:

strPfad = "C:\Dokumente und Einstellungen\UserName\Desktop\Neuer Ordner"

- ich bin davon ausgegangen, dass die zu kopierenden Daten in allen Dateien in Tabelle 1 liegen


Generell kann man natürlich noch so einiges anpassen, aber ich kenne Deine Datei nicht.
Deshalb, wenn etwas nicht so ganz passt, genau beschreiben... am besten: Beispielmappe.

Da ich Dein Verständniss für VBA-Code nicht einschätzen kann, habe ich auf Erklärungen im Code mal verzichtet.
Wenn Du ihn nicht verstehst, lasse ihn im Einzelschrittmodus durchlaufen, und schaue was jeweils gemacht wird.
Wenn Du danach immer noch etwas nicht verstehst, dann frage nach, ich erklärs Dir gerne.


Ich hoffe geholfen zu haben.

 

Vielen lieben Dank schon einmal! Ich habe die Datei auf der Arbeit liegen und werde den Code am Donnerstag direkt mal ausprobieren.
Ich versteh die Codes meistens, allerdings musste ich mich sehr sehr schnell und dadurch extrem oberflächig mit Büchern in die Grundlagen einarbeiten, so dass mir (für mich) Kompliziertes doch schwer fällt.
Liebe Grüße und Danke!!! für Deine Hilfe!!

 

Hallo,
also die Formatierung der Zelle kopiert er mir rein, aber leider nicht den Wert. Wie kommt das?
Liebe Grüße
Anna

 

Hallo Anna,

per Ferndiagnose ist diese Frage nicht einfach zu beantworten.

Aus dem Stehgreif würde ich vermuten, dass ich Deine Beschreibung der Zellbezüge irgendwo falsch verstanden habe, und Excel jetzt eine leere Zelle kopiert.

Hast Du das Makro mal im Einzelschrittmodus durchlaufen lassen, und Dir die jeweiligen Zellbezüge angeschaut?

Ich tippe auf auf: