68023
Goto Top

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

Content-Key: 95822

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

Printed on: April 19, 2024 at 22:04 o'clock

Mitglied: 68023
68023 Sep 02, 2008 at 14:21:37 (UTC)
Goto Top
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
Member: bastla
bastla Sep 02, 2008 at 20:35:10 (UTC)
Goto Top
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
Mitglied: 68023
68023 Sep 03, 2008 at 13:24:47 (UTC)
Goto Top
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
Mitglied: 68023
68023 Sep 03, 2008 at 13:46:53 (UTC)
Goto Top
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
Mitglied: 68023
68023 Sep 03, 2008 at 14:39:28 (UTC)
Goto Top
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
Member: bastla
bastla Sep 03, 2008 at 15:42:41 (UTC)
Goto Top
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
Mitglied: 68023
68023 Sep 04, 2008 at 07:26:18 (UTC)
Goto Top
Hallo bastla,

danke für den Tip!
Du bist mir unheimlich > selbst bei gelösten Topics gibst du noch nicht auf ;)
Also dankeschön!
Nico