Datei öffnen, Bereich kopieren und in neue Datei einfügen (den Wert, nicht das Format!)

  • Excel

Es gibt 9 Antworten in diesem Thema. Der letzte Beitrag () ist von IrishStu.

    Datei öffnen, Bereich kopieren und in neue Datei einfügen (den Wert, nicht das Format!)

    Hallo Excelolaner und Excelolanerinnen,

    ich habe wieder mal ein kleines Problem, das sich zum größeren entwickelt und brauche deshalb eure Hilfe.

    Es geht um ein Makro, welches in einem Verzeichnis nach Dateien mit der Endung ".xlsm" suchen, diese der Reihe nach öffnen und den Bereich "P16:P683" kopieren soll.
    Anschließend soll der kopierte Bereich in meinem Makrodokument in Spalte B2, C2, D2, usw. eingefügt werden. Und zwar mit Werten, nicht mit Formaten! Und genau das funktioniert nicht.

    HIer der bisherige Code:

    VB.NET-Quellcode

    1. Sub Daten_kopieren()
    2. Dim Pfad As String, Dateiname As String, iCol As Long
    3. Application.ScreenUpdating = False
    4. Pfad = "U:\Projekte\Erstverladungen\"
    5. Dateiname = Dir(Pfad & "*.xlsm")
    6. Do While Dateiname <> "" 'solange du in meinem Ordner noch Dokumente mit der Endung xlsm findest, mach Folgendes....
    7. Workbooks.Open Filename:=Pfad & Dateiname 'öffne die Datei im Folgenden Pfad
    8. ActiveWorkbook.Unprotect Password:="sepp" 'Die Dateien sind mit einem Passwort geschützt, Blattschutz usw. wird hier entfernt
    9. ActiveSheet.Unprotect Password:="sepp"
    10. iCol = ThisWorkbook.Sheets("Tabelle1").Range("XFD2").End(xlToLeft).Offset(0, 1).Column 'ich möchte, dass er die letzte Spalte des Tabellenblattes nimmt und dann in Zeile 2 so lange nach links geht, bis er eine gefüllte Zelle findet und dann 1 rechts neben diese 'gefüllte Zelle springt, denn da soll er den kopierten Bereich dann ja per Schleife immer wieder einfügen
    11. Workbooks(Dateiname).Sheets("Verladeliste-Rohbau").Range("P16:P683").Copy 'hier wird der gewünschte Bereich kopiert
    12. ThisWorkbook.Sheets("Tabelle1").Cells(2, iCol).PasteSpecial Paste:=xlPasteValues 'An dieser Stelle funktioniert nichts mehr, denn er bricht immer wieder mit Laufzeitfehler 1004 ab, warum?! Er soll hier den kopierten Bereich in mein Ausgangsdokument einfügen, 'und zwar in Zeile 2 und in der Spalte, die sich 1 rechts neben der letzten befüllten befindet
    13. Application.DisplayAlerts = False 'etwaige Dialogfenster sollen geschlossen werden
    14. Workbooks(Dateiname).Close SaveChanges:=False 'auch möchte ich die Änderungen in den der Reihe nach zu öffnenden Dokumenten (für den Kopiervorgang) nicht speichern, frag mich also nicht und nerv nicht weiter
    15. Dateiname = Dir()
    16. Loop
    17. Application.DisplayAlerts = True 'nach dem Ende der Schleife dürfen Dialogfenster wieder angezeigt werden
    18. End Sub


    Ich habe schon etliche Kombinationen zur PasteSpecial-Zeile ausprobiert, gestern ging es auch einmal, danach ist Excel allerdings abgeschmiert und danach ging es nicht mehr :thumbsup:
    Bin am Verzweifeln, das kann doch nicht so schwer sein. Ach ja, mit .Value anstatt .Copy bleiben die zu befüllenden Zellen übrigens leer.

    Bitte um eure Hilfe!

    Gruß
    IrishStu
    Wär ganz gut, wenn Du das step by step eingrenzt. Kommentier mal alles außer die Zeilen 13 und 14 aus, verweise in Zeile 13 auf dieselbe Tabelle wie in Zeile 14, trag in Zeile 13 und 14 sinnvolle Testzellkoordinaten ein und sobald das funktioniert hat, erweitere die Funktionalität Schritt für Schritt. Fehler 1004 ist sehr allgemein und kann auch schon bei sowas Lächerlichem wie sinnlosen Zellenkoordinaten auftreten, z.B. »Zielspalte = Null«.
    Dieser Beitrag wurde bereits 5 mal editiert, zuletzt von „VaporiZed“, mal wieder aus Grammatikgründen.

    Aufgrund spontaner Selbsteintrübung sind all meine Glaskugeln beim Hersteller. Lasst mich daher bitte nicht den Spekulatiusbackmodus wechseln.
    Hallo VaporiZed,

    es war nur ein Wink mit dem Zaunpfahl, aber er hat eingeschlagen wie Betonklötze. Danke dafür an dieser Stelle. Im Originaldokument war die Spalte B zerschossen, denn in anderen Spalten hat die Paste-Methode geklappt.
    Nachdem ich die Spalte löschte, ließ sich der Code auch dort wieder einfügen. Ich vermute, dass hier die Zellen von Excel durch den Absturz oder die zahlreichen Experimente ungewollt Schaden erlitten haben :(

    Falls es jemanden interessiert, hier ist schon mal der Code, der das Füllen von einer Spalte zum Laufen bringt, wobei eigentlich nicht der vollständige Code benötigt wird, aber ich wollte auf Nummer sicher gehen ;)
    Ich werde demnächst den kompletten Code posten (also mit Schleife, sodass nicht nur 1 Spalte befüllt wird).

    VB.NET-Quellcode

    1. Sub Daten_kopieren()
    2. Dim Pfad As String, Dateiname As String, iCol As Long
    3. Dim PfadOrg As String, DateinameOrg As String
    4. 'Application.ScreenUpdating = False 'funktioniert auch ohne
    5. Pfad = "U:\Projekte\Erstverladungen\"
    6. Dateiname = Dir(Pfad & "*.xlsm")
    7. PfadOrg = "U:\Projekte\Luxhaus\WeidingerW\"
    8. DateinameOrg = Dir(PfadOrg & "Erstverladungen.xlsm")
    9. Do While Dateiname <> ""
    10. Workbooks.Open Filename:=Pfad & Dateiname
    11. ActiveWorkbook.Unprotect Password:="sepp" 'ist eigentlich nicht nötig
    12. ActiveSheet.Unprotect Password:="sepp" 'ist eigentlich nicht nötig
    13. 'iCol = ThisWorkbook.Sheets("Tabelle1").Range("XFD2").End(xlToLeft).Offset(0, 1).Column
    14. Workbooks(Dateiname).Sheets("Verladeliste-Rohbau").Cells.MergeCells = False 'nicht nötig
    15. Workbooks(Dateiname).Sheets("Verladeliste-Rohbau").Range("P16:P683").Copy
    16. Workbooks(DateinameOrg).Sheets("Tabelle1").Range("B2").PasteSpecial Paste:=xlPasteValues
    17. Application.DisplayAlerts = False
    18. Workbooks(Dateiname).Close SaveChanges:=False
    19. Dateiname = Dir()
    20. Loop
    21. Application.DisplayAlerts = True
    22. End Sub

    IrishStu schrieb:

    Workbooks(Dateiname).Sheets("Verladeliste-Rohbau").Range("P16:P683").Copy
    Workbooks(DateinameOrg).Sheets("Tabelle1").Range("B2").PasteSpecial Paste:=xlPasteValues
    Würde ich ohne Umweg über den PasteBuffer lösen.
    PasteBuffer ist immer gefährlich, weil er anwendungsübergreifend verwendet wird.

    Visual Basic-Quellcode

    1. Set SourceRange = Workbooks(Dateiname).Sheets("Verladeliste-Rohbau").Range("P16:P683")
    2. Set DestinationRange = Workbooks(DateinameOrg).Sheets("Tabelle1").Range("B2").Resize(SourceRange.Rows.Count,SourceRange.Columns.Count)
    3. DestinationRange.Value = SourceRange.Value
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --
    Wenn ich es so lasse, dann wird die Schleife 1 Mal durchlaufen und dann verlassen. Wie ändere ich das? Er sagt, dass Dateiname = "" ist, was dazu führt, dass die Schleife verlassen wird.
    Ich verstehe aber nicht, warum Dateiname ="" sein soll, denn ich habe ja Dateiname = Dir (Pfad & "*.xlsm")
    Wenn ich

    Visual Basic-Quellcode

    1. Dateiname = Dir()
    weglasse (am Ende der Schleife), dann befüllt er Spalte für Spalte, aber nur aus ein und derselben Datei.
    Ich möchte aber, dass er nach dem Kopieren und Schließen der ersten Datei die nächste behandelt und nicht immer die gleiche.

    Weiß jemand Rat?

    ....EDIT: kleine Änderung zur Codeoptimierung, die von petaod vorgeschlagen wurde. So sieht das schon besser aus. Gefällt mir. Danke sehr!

    Visual Basic-Quellcode

    1. Sub Daten_kopieren()
    2. 'Variablen für die Pfade und Dateinamen von der Original-Makrodatei und die Erstverladungsdateien
    3. Dim Pfad As String, Dateiname As String, iCol As Long
    4. Dim PfadOrg As String, DateinameOrg As String
    5. Dim SourceRange As Range, DestinationRange As Range
    6. Application.ScreenUpdating = False 'für bessere Performance
    7. Pfad = "U:\Projekte\Erstverladungen\" 'der Pfad, in dem die Erstverladungsdateien liegen
    8. Dateiname = Dir(Pfad & "*.xlsm") 'dort sollen alle Dateien mit der Endung .xlsm behandelt werden
    9. PfadOrg = "U:\Projekte\" 'der Pfad zur Originaldatei
    10. DateinameOrg = Dir(PfadOrg & "Erstverladungen.xlsm") 'namens Erstverladungen.xlsm
    11. 'Schleife zum Copy des Bereichs aus den Erstverladungslisten und Einfügen in der Originaldatei Spalte neben Spalte
    12. Do While Dateiname <> "" 'solange du noch Dateien mit der Endung .xlsm findest
    13. Workbooks.Open Filename:=Pfad & Dateiname 'öffne U:\Projekte\Erstverladungen\*.xlsm
    14. ActiveWorkbook.Unprotect Password:="sepp" 'hebe den Arbeitsmappenschutz auf
    15. ActiveSheet.Unprotect Password:="sepp" 'hebe den Blattschutz auf
    16. 'iCol wird benötigt, um das Kopierte aus JEDER Erstverladungsdatei Spalte neben Spalte in der Originaldatei einzufügen
    17. iCol = Workbooks(DateinameOrg).Sheets("Tabelle1").Range("XFD2").End(xlToLeft).Offset(0, 1).Column
    18. Workbooks(Dateiname).Sheets("Verladeliste-Rohbau").Cells.MergeCells = False
    19. Set SourceRange = Workbooks(Dateiname).Sheets("Verladeliste-Rohbau").Range("P16:P683")
    20. Set
    21. DestinationRange = Workbooks(DateinameOrg).Sheets("Tabelle1").Cells(2,
    22. iCol).Resize(SourceRange.Rows.Count, SourceRange.Columns.Count)
    23. DestinationRange.Value = SourceRange.Value
    24. Application.DisplayAlerts = False
    25. Workbooks(Dateiname).Close SaveChanges:=False
    26. Dateiname = Dir()
    27. Loop
    28. Application.DisplayAlerts = True
    29. End Sub


    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „IrishStu“ ()

    Ich kann grad keinen Fehler finden. Probier mal die Schleife testweise mit einem neuen Ordner, in den Du alle xlsm-Dateien aus dem eigentlichen Ordner reinkopierst. Lass dabei die Zeile 17-33 weg, sodass nur das Wichtigste der Do-Loop durchläuft. Lass Dir ggf. noch mit ner MsgBox die Dateinamen anzeigen. Sind alle dabei?
    Dieser Beitrag wurde bereits 5 mal editiert, zuletzt von „VaporiZed“, mal wieder aus Grammatikgründen.

    Aufgrund spontaner Selbsteintrübung sind all meine Glaskugeln beim Hersteller. Lasst mich daher bitte nicht den Spekulatiusbackmodus wechseln.
    Ich habe nun alle xlsm-Dateien in einen neuen Ordner kopiert und mit diesem neuen Pfad mal ausprobiert. Dabei habe ich die Zeilen 17-33 auskommentiert.
    Der Code zum Test sieht deshalb abgespeckt so aus:

    VB.NET-Quellcode

    1. Sub Daten_kopieren()
    2. Dim Pfad As String, Dateiname As String
    3. Pfad = "C:\Users\Username.WNTC40\Desktop\test\"
    4. Dateiname = Dir(Pfad & "*.xlsm")
    5. PfadOrg = "U:\Projekte\" 'der Pfad zur Originaldatei
    6. DateinameOrg = Dir(PfadnameOrg & "Erstverladungen.xlsm") 'namens Erstverladungen.xlsm
    7. Do While Dateiname <> ""
    8. Dateiname = Dir()
    9. Loop
    10. Application.DisplayAlerts = True
    11. End Sub


    Beim ersten Durchlauf geht er in die Schleife rein und speichert in Dateiname den String "Erstverladung 00001 Kundenname1.xlsm".
    Danach geht er auf Loop und springt wieder zu Do While Dateiname <> ""
    Beim erneuten Drücken auf F8 verlässt er aber die Schleife, weil er meint, Dateiname ist "".
    Eigentlich müsste er aber mit der Datei "Erstverladung 00002 Kundenname2.xlsm" weitermachen :(

    EDIT: Es liegt anscheinend daran, dass die Funktion DIr() hier 2 Mal verwendet wird (siehe Code aus Post #5). Wenn DateinameOrg und PfadOrg auskommentiert werden, läuft die Schleife mehr als 1 Mal durch.

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „IrishStu“ ()

    Da hab ich was anderes bei mir:

    Visual Basic-Quellcode

    1. Sub Makro1()
    2. Dim Pfad As String, Dateiname As String
    3. Pfad = "C:\Users\Zed\Desktop\test\"
    4. Dateiname = Dir(Pfad & "*.xlsm")
    5. Do While Dateiname <> ""
    6. MsgBox Dateiname
    7. Dateiname = Dir()
    8. Loop
    9. End Sub

    Ich habe 3 leere Dateien mit Endung .XLSM im Testordner. Alle werden mir nacheinander in je einer MsgBox angezeigt. »Rätsel über Rätsel«

    EDIT: Guten Morgen, Herr Preil. Ja, klar, Deine zusätzliche Dir-Anweisung für DateinameOrg »überschreibt« quasi den Dir-Zwischenspeicher, sodass er die gefundenen XLSM-Dateie aus dem 1. Aufruf vergisst..
    Dieser Beitrag wurde bereits 5 mal editiert, zuletzt von „VaporiZed“, mal wieder aus Grammatikgründen.

    Aufgrund spontaner Selbsteintrübung sind all meine Glaskugeln beim Hersteller. Lasst mich daher bitte nicht den Spekulatiusbackmodus wechseln.

    Visual Basic-Quellcode

    1. Sub Daten_kopieren()
    2. Dim PfadOrg as string, DateinameOrg as string
    3. Dim Pfad As String, Dateiname As String
    4. Pfad = "C:\Users\Username.WNTC40\Desktop\test\"
    5. PfadOrg = "U:\Projekte\" 'der Pfad zur Originaldatei
    6. DateinameOrg = PfadnameOrg & "Erstverladungen.xlsm" 'namens Erstverladungen.xlsm
    7. Dateiname = Dir$(Pfad & "*.xlsm")
    8. While Len(Dateiname)
    9. Debug.print Pfad & Dateiname
    10. Dateiname = Dir$
    11. Wend
    12. Application.DisplayAlerts = True
    13. End Sub
    Guten Morgen Herr Meister der Schatten,

    stimmt.

    Guten Morgen Herr Eierlein,

    mit Len und der While-Schleife funktioniert das blendend (ist auch von der Performance her recht schnieke).

    Danke sehr!

    Noch mal alles zusammen gefasst für etwaige Nachahmer:

    VB.NET-Quellcode

    1. Sub Daten_kopieren()
    2. Dim Pfad As String, Dateiname As String, iCol As Long
    3. Dim PfadOrg As String, DateinameOrg As String
    4. Dim SourceRange As Range, DestinationRange As Range
    5. 'Application.ScreenUpdating = False
    6. Pfad = "U:\Projekte\Erstverladungen\"
    7. PfadOrg = "U:\Projekte\"
    8. DateinameOrg = Dir(PfadOrg & "Erstverladungen.xlsm")
    9. Dateiname = Dir$(Pfad & "*.xlsm")
    10. While Len(Dateiname) 'solange du Zeichen in Dateiname hast, also nicht null bist, bleib in der Schleife
    11. Workbooks.Open Filename:=Pfad & Dateiname 'öffne U:\Projekte\Erstverladungen\*.xlsm
    12. 'ActiveWorkbook.Unprotect Password:="sepp" 'hebe den Arbeitsmappenschutz auf
    13. 'ActiveSheet.Unprotect Password:="sepp" 'hebe den Blattschutz auf
    14. iCol = Workbooks(DateinameOrg).Sheets("Tabelle1").Range("XFD2").End(xlToLeft).Offset(0, 1).Column
    15. 'Workbooks(Dateiname).Sheets("Verladeliste-Rohbau").Cells.MergeCells = False
    16. Set SourceRange = Workbooks(Dateiname).Sheets("Verladeliste-Rohbau").Range("P16:P683")
    17. Set DestinationRange = Workbooks(DateinameOrg).Sheets("Tabelle1").Cells(2, iCol).Resize(SourceRange.Rows.Count, SourceRange.Columns.Count)
    18. DestinationRange.Value = SourceRange.Value
    19. Application.DisplayAlerts = False
    20. Workbooks(Dateiname).Close SaveChanges:=False
    21. Dateiname = Dir$
    22. Wend
    23. Application.DisplayAlerts = True
    24. End Sub


    Der auskommentierte Code wird nicht benötigt, könnte aber mit eingebaut werden (z.B. Blattschutz/Arbeitsmappenschutz aufheben oder Zellverbindungen aufheben).
    Da sich insbesondere die Aufhebung des Schutzes im Debugger auf die Performance niederschlägt, würde ich diesen Teil des Codes weglassen, wenn er nicht dringend benötigt wird.
    Es gibt hierzu sicherlich elegantere Lösungen, welche mir aber nicht bekannt sind.