Tabelle in andere Arbeitsmappe kopieren

Hallo,

ich benötige bei folgendem Problem Hilfestellung:
Mein Skript durchläuft eine Liste mit Dateinamen (datei), sucht sich daran ein spezielles Blatt (land) und soll diese nun in eine Sammel-Datei (hier) kopieren.

Beim Kopieren muss ich irgendwas durcheinander gebracht haben, denn nicht der Inhalt der geöffneten Datei sondern der Inhalt der Sammel-Datei wird kopiert:

            Workbooks(datei).Activate
            Sheets(land).Activate
                                       
            Range("A1:Z176").Copy  
                     
            Workbooks(hier).Activate
            Sheets(land).Activate
            ActiveSheet.Paste
            
            Workbooks(datei).Activate
            ActiveWorkbook.Close

Ich krieg die Peilung nicht ;)
Bestimmt ist der Fehler ganz offensichtlich. Bin für einen Wink dankbar!

Das fertige Skript ist denke ich sehr nützlich, werde daraus eine Anleitung schmieden!

Gruß
Nico

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

Content-ID: 95822

Url: https://administrator.de/forum/tabelle-in-andere-arbeitsmappe-kopieren-95822.html

Ausgedruckt am: 28.04.2025 um 05:04 Uhr

7 Kommentare

Neuester Kommentar

Hallo,

mittlerweile habe ich den Fehler vielleicht etwas eingegrenzt:

            Workbooks(datei).Sheets(land).Activate
                                       
            Range("A1:Z176").Copy  
                     
            Workbooks(hier).Activate
            Sheets(land).Activate
            ActiveSheet.Paste
            
            Workbooks(datei).Activate
            ActiveWorkbook.Close

Ich bin jetzt zwar nachweislich im richtigen Sheet aber kopiert wird trotzdem irgendwas anderes...
Ich kann keinen Logikfehler sehen....... Bitte um Hilfe!

Danke!
Nico

Hallo prinzipal87!

Du kannst zwar den Code etwas kompakter gestalten, zB

Workbooks(datei).Sheets(land).Range("A1:Z176").Copy  
Workbooks(hier).Sheets(land).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Workbooks(datei).Close

aber bei mir funktioniert auch schon Deine Version - so gesehen könnte es eigentlich nur am Variablenínhalt von "datei" oder "land" liegen ...

Grüße
bastla

Hallo,

jetzt habe ich das ganze Projekt folgendermaßen erweitert:
1. es sollen alle Excel-Dateien eines Verzeichnisses in einer zusammegefasst werden (hierfür müssen alle Tabellen in die Konsolidierungsdatei kopiert werden)
2. gleiche Anforderung aber mit automatischer Umbenennung

Es hapert noch im 1. Schritt ;)

Laufzeitfehler 9, Index im ungültigen Bereich bekomme ich zwischen den Zeilen 22-27 beim zweiten Durchgang (beim ersten Durchgang findet das Skript sich selber und weicht entsprechend aus)

Sub AlleTabelleninVerzeichniszusammenziehenbeigleichemNamen()
Dim i As Integer
Dim z As Integer
Dim mappe As Workbook
Dim mname As String
Dim hier As String
Dim tabelle As Worksheet


With Application.FileSearch
.NewSearch
.LookIn = ActiveWorkbook.Path
.SearchSubFolders = fale
.FileType = msoFileTypeExcelWorkbooks
.Execute

For i = 1 To .FoundFiles.Count
    
    mname = .FoundFiles(i)
    hier = ActiveWorkbook.Path & "\" & ActiveWorkbook.name  
    If mname <> hier Then
        Workbooks.Open .FoundFiles(i), UpdateLinks:=0, ReadOnly:=True
        Workbooks(mname).Activate
        
        For z = 1 To ActiveWorkbook.Worksheets.Count
               
             Workbooks(mname).Sheets(z).Copy after:=Workbooks(ActiveWorkbook.name).Sheets(1)
                  
        Next z
        'Workbooks(mname).Close  
    End If
Next i
End With
End Sub

Vielen Dank für Eure Hilfe! Macht Spaß hier!!!
Nico

Hallo,

es muss an dieser Zeile liegen:

Workbooks.Open .FoundFiles(i), UpdateLinks:=0, ReadOnly:=True

Kann es sein, dass es nicht klappt, weil ich in FoundFiles einen absoluten Dateipfad mitbekomme statt einer Workbook-Bezeichnung?

Nico

Ja am Schönsten ist es ja, wenn man selber zur Lösung kommt.
Es war tatsächlich der Pfad usw...

Hier eine lauffähige Version!

Sub AlleTabelleninVerzeichniszusammenziehenbeigleichemNamen()
Dim i As Integer
Dim z As Integer
Dim mappe As Workbook
Dim mname As String
Dim hier As String
Dim hierwb As String
Dim tabelle As Worksheet

hierwb = ActiveWorkbook.name

With Application.FileSearch
.NewSearch
.LookIn = ActiveWorkbook.Path
.SearchSubFolders = fale
.FileType = msoFileTypeExcelWorkbooks
.Execute

For i = 1 To .FoundFiles.Count
    
    mname = .FoundFiles(i)
    
    z = InStr(1, mname, ":")  
    If z <> 0 Then
        mname = Right(mname, (Len(mname) - z))
    End If
 
    Do While InStr(1, mname, "\") <> 0  
        z = InStr(1, mname, "\")  
        mname = Right(mname, (Len(mname) - z))
    Loop
 
    If mname <> hierwb Then
        Workbooks.Open mname, UpdateLinks:=0, ReadOnly:=True
        Workbooks(mname).Activate
        
        For z = 1 To ActiveWorkbook.Worksheets.Count
               
             Workbooks(mname).Sheets(z).Copy after:=Workbooks(hierwb).Sheets(1)
                  
        Next z
        
        Workbooks(mname).Close
    End If
Next i
End With
End Sub

Hallo prinzipal87!

Noch als Anmerkung zu der Zerlegung in den Zeilen 23 - 31:

Etwas eleganter wird es mit InStrRev()

z = InStrRev(mname, "\")  
If z > 0 Then mname = Mid(mname, z + 1)

oder mit Split()

temp = Split(mname, "\")  
mname = temp(UBound(temp))

Beide Beispiele berücksichtigen keinen ":", da die Zerlegung ohnehin vom Ende her erfolgt und eine Pfadangabe der Art "D:Datei.xls" (also ohne enthaltenen "\") zwar erlaubt und möglich, aber hier nicht zu erwarten ist.

Schließlich gäbe es noch bei Verwendung des "FileSystemObject" die Methoden ".GetBaseName" und ".GetExtensionName" (erstere liefert nur den Namen, ohne Pfad und Typ, letztere nur den Dateityp) oder einfach nur ".GetFileName".

Grüße
bastla