Excel VBA CopyNPaste Multiple Values

Hi Freunde der Sonne,

folgender Code liefert mir kein Ergebnis:

Sub DatenAusQuelldateienKopieren()
    Dim QuellOrdner As String
    Dim AktiveMappe As Workbook
    Dim QuellArbeitsmappe As Workbook
    Dim Wochentag As String
    Dim ZeileH As Integer
    Dim ZeileI As Integer
    Dim ZeileJ As Integer
    
    QuellOrdner = "D:\"  
    
    Set AktiveMappe = ThisWorkbook
    
    Dim SubOrdner As Object
    Dim Datei As Object
    Dim Folder As Object
    
    Set SubOrdner = CreateObject("Scripting.FileSystemObject").GetFolder(QuellOrdner)  
    
    For Each Folder In SubOrdner.SubFolders
        For Each Datei In Folder.Files
            Set QuellArbeitsmappe = Workbooks.Open(Datei.Path)
            Dim ZielBlatt As Worksheet
            Wochentag = UCase(QuellArbeitsmappe.Sheets(1).Range("A2").Value)  
            For Each ZielBlatt In AktiveMappe.Sheets
                If Wochentag = ZielBlatt.Name Then
                    Select Case QuellArbeitsmappe.Sheets(1).Range("B2").Value  
                        Case "A"  
                            ZeileH = 6
                            ZeileI = 6
                            ZeileJ = 6
                        Case "B"  
                            ZeileH = 7
                            ZeileI = 7
                            ZeileJ = 7
                        Case "C"  
                            ZeileH = 8
                            ZeileI = 8
                            ZeileJ = 8
                        Case "D"  
                            ZeileH = 9
                            ZeileI = 9
                            ZeileJ = 9
                        Case "E"  
                            ZeileH = 10
                            ZeileI = 10
                            ZeileJ = 10
                        Case "F"  
                            ZeileH = 11
                            ZeileI = 11
                            ZeileJ = 11
                        Case "G"  
                            ZeileH = 12
                            ZeileI = 12
                            ZeileJ = 12
                        Case "H"  
                            ZeileH = 13
                            ZeileI = 13
                            ZeileJ = 13
                        Case "I"  
                            ZeileH = 14
                            ZeileI = 14
                            ZeileJ = 14
                        Case "J"  
                            ZeileH = 15
                            ZeileI = 15
                            ZeileJ = 15
                        Case "K"  
                            ZeileH = 16
                            ZeileI = 16
                            ZeileJ = 16
                        Case Else
                    End Select  
                    ZielBlatt.Range("H" & ZeileH).Value = QuellArbeitsmappe.Sheets(1).Range("F2").Value  
                    ZielBlatt.Range("I" & ZeileI).Value = QuellArbeitsmappe.Sheets(1).Range("F6").Value  
                    ZielBlatt.Range("J" & ZeileJ).Value = QuellArbeitsmappe.Sheets(1).Range("F10").Value  
                End If
            Next ZielBlatt
            QuellArbeitsmappe.Close SaveChanges:=False
        Next Datei
    Next Folder
End Sub

Ich möchte Daten aus mehreren Quellmappen in eine Mastermappe kopieren. Dafür schaue ich mir den Zellwert an und vergleiche den mit dem Arbeitsblattnamen, bei einem Match soll er mir anschließend basierend auf einer Fallunterscheidung die daraus resultierend die Daten in die vorgesehenen Zellen in der aktiven Mappe einfügen. Was könnte hier die Ursache sein?

Danke und Gruß!
Basti

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 7899232298

Url: https://administrator.de/contentid/7899232298

Ausgedruckt am: 23.11.2024 um 22:11 Uhr

2 Kommentare

Neuester Kommentar

Guten Morgen,

Was heißt, der Code liefert kein Ergebnis?
Ich vermute, du meinst, dass in deiner Haupttabelle keine Daten eingefügt werden

Ohne die Daten kann man das aus der Ferne schlecht nachstellen. Damit kann man den Fehler auch schwer finden. Du kannst das aber natürlich selber machen, indem du Debugging nutzt oder einfach zwischendurch die Werte in einer MsgBox anzeigen lässt, dann solltest du ganz schnell identifizieren können, wo es hakt.

Gruß

DivideByZero