Office: (Office 2013) bestehendes Tabellenblatt-kopier-Makro auf Spalten-kopieren ändern

Helfe beim Thema bestehendes Tabellenblatt-kopier-Makro auf Spalten-kopieren ändern in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Hallo, ich habe da eine (hoffentlich)klene Frage: Ich abe ein Makro im Internet gefunden das bisher meinen Wünschen entspricht. Das Makro kopiert... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von ahalbeu, 27. Juni 2015.

  1. ahalbeu Erfahrener User

    bestehendes Tabellenblatt-kopier-Makro auf Spalten-kopieren ändern


    Hallo,
    ich habe da eine (hoffentlich)klene Frage:

    Ich abe ein Makro im Internet gefunden das bisher meinen Wünschen entspricht. Das Makro kopiert ganze Tabellenblätter aus mehreren Dateien in eine Zusammenfassung. Dazu fragt es wo die Dateien gespeichert sind, und gibt den neuen Tabellenblätter in der neuen Datei den Dateinamen als Sheetnamen. Funktionier talles tadellos.

    Nun bräuchte ich eine Änderung die mir aus einem Tabellnblatt (erstes Tabellenblatt in allen Dateien genant "Wochenansicht") nur die komplette Spalten L und M kopiert. Habe schon mit allen Änderungen die ich gefunden habe versuct das Makro umzuschreiben (Column; Range, selection,...) bekomme dan aber ur Fehlermeldungen.
    Leere Zeilen sollen mitkopiert werden.

    Kann mir jemand helfen? Bin in VBA ein blutiger Anfänger. Habe Office 2013

    Zur Info: Die Dateien sind eine AUflistung von Messwerten je Kalenderwoche im 4 Sekundentakt. Das bedeutet dass die Datein zimlich groß sind (je Woche 151200 Werte). Also müsten auch die SPalten nur bis dahin kopiert weden. Hoffe das macht keine Probleme.

    Hier das Makro

    Code:
    Sub kopie()
     Dim oTargetBook As Object
       Dim oSourceBook As Object
       Dim sPfad As String
       Dim sDatei As String
       Dim oFileDialog As FileDialog
    
         Application.ScreenUpdating = False 'Das "Flackern" ausstellen
         Application.DisplayAlerts = False 'Keine Fehlermeldungen anzeigen
    
         'Schritt 1: Arbeitsmappe festlegen, in die die neuen Sheets eingefügt werden...
         Set oTargetBook = ActiveWorkbook
    
         'Wichtiger Hinweis: Die Arbeitsblätter dürfen nicht vorhanden sein!
         'Alternativer Umbau: Löschen evtl. bereits vorhandener Arbeitsblätter
    
         'Schritt 2: Schleife über alle Excel Dateien in einem Verzeichnis
         Set oFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
         With oFileDialog
            .Title = "Importverzeichnis wählen..."
            .ButtonName = "Import"
            If .Show = -1 Then sPfad = .SelectedItems(1)
         End With
         If Trim(sPfad) = "" Then Exit Sub
         If Right(sPfad, 1) <> "\" Then sPfad = sPfad & "\"
         sDatei = Dir(CStr(sPfad & "*.xl*")) 'Alle Excel Dateien
    
         Do While sDatei <> ""
    
             'Schritt 3: öffnen der Datei und Datenübertragung
             Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True) 'nur lesend öffnen
    
             'Es wird immer das erste Tabellenblatt Sheets(1) kopiert!
             oSourceBook.Sheets(3).Copy after:=oTargetBook.Sheets(oTargetBook.Sheets.Count)
             ActiveSheet.UsedRange.Cells = ActiveSheet.UsedRange.Cells.Value
    
             'Es wird versucht den Dateinamen als Arbeitsblattnamen zu setzen.
             'Ist dieser bereits vorhanden wird der Fehler abgefangen und das neue Blatt
             'bekommt keinen anderen Namen und behält den typischen Namen Tabelle x
             On Error Resume Next
    
             'Arbeitsblattname wird der Dateiname
             oTargetBook.Sheets(oTargetBook.Sheets.Count).Name = sDatei
    
             'Wenn ein Fehler aufgetreten ist, wird dieser resettet
             If Err.Number <> 0 Then
                Err.Number = 0
                Err.Clear
             End If
             On Error GoTo 0
    
             'Schritt 4: Datei wieder zu machen und nächste Schleifenrunde
             oSourceBook.Close False 'nicht speichern
    
             'Nächste Datei
             sDatei = Dir()
    
         Loop
    
         Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
         Application.DisplayAlerts = True 'Fehlermeldungen wieder anzeigen
    
         'Kleine finale Fertig-Meldung
         MsgBox "Fertig!", vbInformation + vbOKOnly, "Hinweis!"
    
         'Variablen aufräumen
         Set oTargetBook = Nothing
         Set oSourceBook = Nothing
    End Sub
     
    ahalbeu, 27. Juni 2015
    #1
  2. fette Elfe Erfahrener User
    Hallo ahalbeu,

    zuersteinmal ist mir folgendes aufgefallen:
    Die "3" im Code müsste in eine "1" geändert werden, wenn wirklich immer auf das erste Blatt der Dateien zugegriffen werden soll.


    Als zweites ist mir aufgefallen, dass in Deinem Makro Systemeinstellungen verändert werden, ohne diese Veränderungen durch eine ordentliche Fehlerbehandlung abzusichern, bzw. vorher überhaupt ersteinmal zu prüfen wie diese Einstellungen aktuell überhaupt stehen:
    Code:
         Application.ScreenUpdating = False 'Das "Flackern" ausstellen
         Application.DisplayAlerts = False 'Keine Fehlermeldungen anzeigen
    Das kann man so machen, sollte man sich aber eigentlich garnicht erst angewöhnen.
    ;O)


    Als drittes ist mir aufgefallen, dass Du mit der Zeile:
    Code:
             ActiveSheet.UsedRange.Cells = ActiveSheet.UsedRange.Cells.Value
    eventuelle Formeln etc. in Werte umwandelst.
    Ist das notwendig? Sind die Messreihen nicht eh schon reine Werte?
    Obendrein sollte man "ActiveSheet" eigentlich nur benutzen, wenn es sich garnicht vermeiden lässt, bzw. vor allem auch nur, wenn man sich absolut sicher sein kann, welches Blatt gerade das aktive ist. Eine definierte Referenzierung ist deshalb immer vorzuziehen.


    Und als viertes ist mir aufgefallen, dass Du überhaupt nicht schreibst, wohin die beiden Spalten L und M kopiert werden sollen.
    Sollen Sie wieder in L und M? Oder in A und B?


    Aber nun zu meinem Lösungsvorschlag:
    Code:
         Do While sDatei <> ""
    
    [COLOR=#ff0000]         ' ein neues Arbeitsblatt in der Zieldatei erstellen (immer an letzter Stelle)
             oTargetBook.Worksheets.Add After:=Worksheets(oTargetBook.Worksheets.Count)[/COLOR]
    
             'Schritt 3: öffnen der Datei und Datenübertragung
             Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True) 'nur lesend öffnen
             'Es wird immer das erste Tabellenblatt Sheets(1) kopiert!
             oSourceBook.[COLOR=#ff0000]Work[/COLOR]sheets(1)[COLOR=#ff0000].Range("L:M")[/COLOR].Copy [COLOR=#ff0000]Destination[/COLOR]:=oTargetBook.[COLOR=#ff0000]Work[/COLOR]sheets(oTargetBook.Worksheets.Count)[COLOR=#ff0000].Range("L:M")[/COLOR]
             [COLOR=#ff0000]oTargetBook.Worksheets(oTargetBook.Worksheets.Count)[/COLOR].UsedRange.Cells = [COLOR=#ff0000]oTargetBook.Worksheets(oTargetBook.Worksheets.Count)[/COLOR].UsedRange.Cells.Value
    Da ich nicht weiß, welche Zelldetails Du alle benötigst (ich kenne Deine Datei nicht), habe ich beim obigen Vorschlag Deine Kopiermethode übernommen.
    Effektiver wäre aber sicherlich, auf das nachträgliche ändern in Zellwerte zu verzichten (falls überhaupt notwendig) und direkt nur Zellwerte (und eventuell Formate) zu übertragen:
    Code:
         Do While sDatei <> ""
    
             ' ein neues Arbeitsblatt in der Zieldatei erstellen (immer an letzter Stelle)
             oTargetBook.Worksheets.Add After:=Worksheets(oTargetBook.Worksheets.Count)
    
             'Schritt 3: öffnen der Datei und Datenübertragung
             Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True) 'nur lesend öffnen
             'Es wird immer das erste Tabellenblatt Sheets(1) kopiert!
             oSourceBook.Worksheets(1).Range("L:M").Copy
             [COLOR=#ff0000]oTargetBook.Worksheets(oTargetBook.Worksheets.Count).Range("L:M").PasteSpecial Paste:=xlPasteValuesAndNumberFormats[/COLOR]
    Und falls das ändern in Zellwerte eh überflüssig ist, benutze die obere Lösung (copy destination) und lass einfach die Zeile darunter weg.
    ;O)





    Nachtrag:
    Willst Du wirklich auch die Dateiendung im Arbeitsblattnamen? Sollte die nicht mit "split" vorher entfernt werden?
     
    Zuletzt bearbeitet: 28. Juni 2015
    fette Elfe, 28. Juni 2015
    #2
  3. ahalbeu Erfahrener User
    Hallo,
    danke für die erste Antwort.
    Zu deinen Anmerkungen:

    1.Das mit dem ersten Tabellnblat ist bekannt. Habe bei er anderen Kopieraktion das dritte benötigt, daher stet das noch so drinnen.

    2. Das mit den Fehlermeldungen ist so ne Sache. Ich habe in der Quelldatei Zellbezügezu anderen Dateien. Beim öfnen kommt imer die Meldung mit dem aktualisieren. Ob das jetzt eine so ausgeschaltete Fehlermeldung ist, weis ich nicht (bin blutiger VBA-Anfänger). Bei der anderen Kopieraktion hat das wunderbar geklappt, deswegen wollte ich das Makro eigentlich so wie es ist gröstenteils stehen lassen.

    3. Ich brauche keine Formeln, nur die Werte da Zelle L und M aus anderen Werten der Quelldatei berechnet werden. beides sind Zahlen die auf Stanartformat der Zellen eingestellt sind

    4. Wie müsste ich das umschreiben? Dachte eigentlich durch den vorherigen öffnn Befehl ist das soweit klar. WIe gesagt,hat bisher alles wunderbar funtioniert, auch wenn ich die gesamten Tabellenblätter kopiereklppt das. brauch aber fü meine weitere Auwertung eigentlich nur Spalte L und M

    5. wo die dann tehen ist eigenlich egal, Würde Spalte B und D (wenns einfacher ist auch B/C oder sogar A/B gehen), ist eigentlich schnurz, da ich die Werte nur sammeln und vergleichen will/muss

    6. was meinst du mit Zelldetails? ich brauche lediglich die Werte aus den Spalten. Sind beides Zahlenwerte, also kann auch das Format in der neuen Datei auf standart bleiben. Ich glaube für die nächste kopieraktion muss ich das Format mit übertragen (Datum und Uhrzeit). Was wird denn in meinem Makro an Zellwerten geändert? (Blutiger VBA-Anfänger)


    7. der Dateiname als Tabellenname fand ich gut, meine Dateien heisen KW 01 bis KW 53, Tabellen heisen dann eben KW 1.xlsx... das ist mir schnurz, wär naürlich schöner wenns nu KW 01 bis KW 52 heisen würden. Hab das Makro eben so fertig gefunden, und selbst das mit der Namensgebung fand ich sehr passend.

    werde die vorgeschlagenen Änderungen später mal testen, und mich nochmal melden

    Danke schonmal im vorraus, bis dann
     
    ahalbeu, 28. Juni 2015
    #3
  4. fette Elfe Erfahrener User

    bestehendes Tabellenblatt-kopier-Makro auf Spalten-kopieren ändern

    Wie gesagt, kannst Du ja auch.
    Nur würde ich es nicht uneingeschränkt empfehlen.
    Der beste Weg wäre, erstmal durch das Makro zu prüfen, welchen Wert diese beiden Einstellungen aktuell haben, und diese beiden Werte in Variablen "zu speichern". Dann die Einstellungen so ändern wie Du möchtest, und am Ende des Makros die Einstellungen wieder auf den Urzustand bringen (die ursprünglichen Werte hast Du ja noch in den Variablen).
    Und damit das System nicht unbeabsichtig verändert bleibt, falls das makro (egal warum) doch einmal abschmiert und nicht korrekt bis zum Ende durchläuft, baut man das ganze in eine Fehlerbehandlung ein, die im Falle von nicht verarbeiteten Fehlern dafür sorgt, dass die Einstellungen wieder in den ursprünglichen Zustand versetzt werden.
    Aber wie gesagt, muss man nicht machen.
    ;O)



    Dachte ich mir. Dann kannst Du Dir diese Zeile auch sparen:
    Code:
    ActiveSheet.UsedRange.Cells = ActiveSheet.UsedRange.Cells.Value


    Mit Zelldetails meinte ich Formatierungen, Hyperlinks, Formeln usw....



    Am Dateinamen als Blattnamen ist auch überhaupt nichts auszusetzen. Ich habe auf die Dateiendung aufmerksam gemacht.
    ;O)
    Wenn Du die weghaben möchtest, könnte man den Code so schreiben:
    Code:
             'Arbeitsblattname wird der Dateiname
             oTargetBook.Sheets(oTargetBook.Sheets.Count).Name = Left(sDatei, InStrRev(sDatei, ".") - 1)
    (mit "Split" habe ich mich vertan, "InstRev" ist besser geeignet)
     
    Zuletzt bearbeitet: 28. Juni 2015
    fette Elfe, 28. Juni 2015
    #4
  5. ahalbeu Erfahrener User
    Hallo,

    erstmal vielen Dank, klappt super. (Ich war nah dran an der Lösung, einzig das "Work" vor den Sheets im Kopierbefehl hat gefehlt. Was da jetzt der Unterschied ist, weis ich nicht, wäre aber gut zu wissen, da der blutiger Anfänger zum wissbegierigem Lehrling geworden ist ;) )

    Ich hab zusätzlich noch ein paar Änderungen gemacht.

    1. Ich lasse 2 Kopierbefehle in der Schleife durchlaufen: einmal Spalte A und B (Datum und Uhrzeit) in Spalte A und B (Werte und Format) und dann Spalte N und O in Spalte C und D (nur Werte)

    2. habe ich mit dem Splitbefehle gearbeitet. es scheint dennoch zu funktioniern ( mit 2 Dateien getestet) Mein splt und Namensbefehl sieht dann so aus
    Code:
    TName = Split(sDatei, ".")(0)
             
             
             oTargetBook.Sheets(oTargetBook.Sheets.Count).Name = TName
    
    (natürlich noch TNme als String festlegen)

    was gibts denn an Split auszuseten? Werde den InstRev Befehl verwenden, bin aber Lehrling und würde gern den Unterschied wissen (Antwort auf Lehrlingsniveu)

    Mein ganzer Code sieht nu so aus
    Code:
    ] Sub kopie()
     Dim oTargetBook As Object
       Dim oSourceBook As Object
       Dim sPfad As String
       Dim sDatei As String
       Dim oFileDialog As FileDialog
       
       
    
         Application.ScreenUpdating = False 'Das "Flackern" ausstellen
         Application.DisplayAlerts = False 'Keine Fehlermeldungen anzeigen
    
         'Schritt 1: Arbeitsmappe festlegen, in die die neuen Sheets eingefügt werden...
         Set oTargetBook = ActiveWorkbook
    
         'Wichtiger Hinweis: Die Arbeitsblätter dürfen nicht vorhanden sein!
         'Alternativer Umbau: Löschen evtl. bereits vorhandener Arbeitsblätter
    
         'Schritt 2: Schleife über alle Excel Dateien in einem Verzeichnis
         Set oFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
         With oFileDialog
            .Title = "Importverzeichnis wählen..."
            .ButtonName = "Import"
            If .Show = -1 Then sPfad = .SelectedItems(1)
         End With
         If Trim(sPfad) = "" Then Exit Sub
         If Right(sPfad, 1) <> "\" Then sPfad = sPfad & "\"
         sDatei = Dir(CStr(sPfad & "*.xl*")) 'Alle Excel Dateien
    
         Do While sDatei <> ""
    
             'Schritt 3: öffnen der Datei und Datenübertragung
             Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True) 'nur lesend öffnen
             ' ein neues Arbeitsblatt in der Zieldatei erstellen (immer an letzter Stelle)
             oTargetBook.Worksheets.Add After:=Worksheets(oTargetBook.Worksheets.Count)
             'Es wird immer das erste Tabellenblatt Sheets(1) kopiert!
             oSourceBook.Worksheets(1).Range("A:B").Copy Destination:=oTargetBook.Worksheets(oTargetBook.Sheets.Count).Range("A:B")
             oTargetBook.Worksheets(oTargetBook.Worksheets.Count).UsedRange.Cells = oTargetBook.Worksheets(oTargetBook.Worksheets.Count).UsedRange.Cells.Value
             
             oSourceBook.Worksheets(1).Range("N:O").Copy
             oTargetBook.Worksheets(oTargetBook.Worksheets.Count).Range("C:D").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
             'Es wird versucht den Dateinamen als Arbeitsblattnamen zu setzen.
             'Ist dieser bereits vorhanden wird der Fehler abgefangen und das neue Blatt
             'bekommt keinen anderen Namen und behält den typischen Namen Tabelle x
             On Error Resume Next
    
             'Arbeitsblattname wird der Dateiname
                    
             
             oTargetBook.Sheets(oTargetBook.Sheets.Count).Name = Left(sDatei, InStrRev(sDatei, ".") - 1)
    
             'Wenn ein Fehler aufgetreten ist, wird dieser resettet
             If Err.Number <> 0 Then
                Err.Number = 0
                Err.Clear
             End If
             On Error GoTo 0
    
             'Schritt 4: Datei wieder zu machen und nächste Schleifenrunde
             oSourceBook.Close False 'nicht speichern
    
             'Nächste Datei
             sDatei = Dir()
    
         Loop
    
         Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
         Application.DisplayAlerts = True 'Fehlermeldungen wieder anzeigen
    
         'Kleine finale Fertig-Meldung
         MsgBox "Fertig!", vbInformation + vbOKOnly, "Hinweis!"
    
         'Variablen aufräumen
         Set oTargetBook = Nothing
         Set oSourceBook = Nothing
    End Sub 
     
    Zuletzt bearbeitet: 28. Juni 2015
    ahalbeu, 28. Juni 2015
    #5
  6. fette Elfe Erfahrener User
    Hallo ahalbeu,

    an "Split" gibt es garnix auszusetzen.
    ;O)
    Aber es arbeitet anders als die Version mit "InstRev".
    Mit "InstrRev" wird alles bis zu dem ersten "." von rechts ausgegeben, also der komplette Name ohne Endung.
    Das klappt auch, falls jemand mal einen "." mitten im Dateinamen benutzt.
    Mit "Split" geht das nicht so einfach.

    Lass einfach mal den folgenden Code bei Dir laufen, dann siehst Du den Unterschied:
    Code:
    Public Sub SplitUndInstrRev()
    
    Dim sDatei As String
    
        sDatei = "Quelle.Test.xls"
        
        MsgBox Split(sDatei, ".")(0)
        MsgBox Left(sDatei, InStrRev(sDatei, ".") - 1)
    
    End Sub
     
    fette Elfe, 28. Juni 2015
    #6
  7. ahalbeu Erfahrener User
    Hallo nochmal.

    Habe das Makro jetzt durhlaufen lassen, un ist es währen der 5ten Datei zu einem Fehler gekommen.

    "Laufzeitfehler 9 - Index außerhalb des gültigen Bereiches"

    markiert wird folgende Codezeile (nach drücken von Debuggen)
    Code:
    oTargetBook.Worksheets.Add After:=Worksheets(oTargetBook.Worksheets.Count)
    
    Was ist der Fehler und was ist zu tun?
     
    ahalbeu, 28. Juni 2015
    #7
  8. fette Elfe Erfahrener User

    bestehendes Tabellenblatt-kopier-Makro auf Spalten-kopieren ändern

    Nachtrag:
    Code:
    Set oTargetBook = ActiveWorkbook
    würde ich durch
    Code:
    Set oTargetBook = ThisWorkbook
    ersetzen (Begründung siehe weiter oben)



    Mit
    Code:
    If Trim(sPfad) = "" Then Exit Sub
    beendest Du das Makro, ohne die anfänglich veränderten Einstellungen wieder zurück zu setzen.
    Besser wäre zum Beispiel die Benutzung einer Sprungmarke:
    Code:
    If Trim(sPfad) = "" Then GoTo Beenden
    und dann ganz unten:
    Code:
         Loop
    
    [COLOR=#ff0000]Beenden:[/COLOR]
         Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
         Application.DisplayAlerts = True 'Fehlermeldungen wieder anzeigen
         
         [COLOR=#ff0000]If Trim(sPfad) = "" Then Exit Sub[/COLOR]
    
         'Kleine finale Fertig-Meldung
         MsgBox "Fertig!", vbInformation + vbOKOnly, "Hinweis!"
    
         'Variablen aufräumen
         Set oTargetBook = Nothing
         Set oSourceBook = Nothing
    End Sub


    Und den Kopiervorgang für die Spalten "A:B" würde ich so machen:
    Code:
             oSourceBook.Worksheets(1).Range("A:B").Copy
             oTargetBook.Worksheets(oTargetBook.Worksheets.Count).Range("A:B").PasteSpecial Paste:=xlPasteValues
    Damit sparst Du Dir die verwendung von "UsedRange" (ist in Deinem Fall nicht unbedingt sinnvoll), und vor allem sparst Du Dir ein unnötiges Ändern von Zellen. Das verlangsamt nur.
     
    fette Elfe, 28. Juni 2015
    #8
  9. fette Elfe Erfahrener User
    Wieviele Blätter hat Deine Datei denn bereits?
     
    fette Elfe, 28. Juni 2015
    #9
  10. ahalbeu Erfahrener User
    da die Mappe leer war, hatte Sie beim start des Makros nur 1, dann hat es 4 Tabellenbläter kopiert und beim 5ten kam der Fehler

    als ich das makro mit ganzen tabellenblättern schon erfolgreich enutzt habe, hatte ich insgesamt 54 tabellenblätter (aber it weniger Zeilen)
    ist de Datei etwa zu Groß?

    Nachtrag:
    Händisch kann ich es einfügen. Wenn ich das Makro laufen lasse dann öffnet er die quelldatei und haut dann en Fehler raus
     
    Zuletzt bearbeitet: 28. Juni 2015
    ahalbeu, 28. Juni 2015
    #10
  11. fette Elfe Erfahrener User
    Das sollte nicht der Grund sein, ich habe schon mit Mappen mit mehreren Hundert Arbeitsblättern gearbeitet. Wollte nur sicher gehen.

    Kannst Du bitte Deine Zieldatei und eine Quelldatei hier im Forum hochladen, damit man den Fehler nachvollziehen kann?
    Anonymisiere an Daten, was nicht öffentlich gehört, und begrenze die Anzahl der Datensätze auf max. 100 oder weniger, das reicht.
     
    fette Elfe, 28. Juni 2015
    #11
  12. ahalbeu Erfahrener User
    Die Zeile die den Fehler ausgibt habe ich auf dein Anraten hin eingefügt( leeres Tabelenblattt am Ende erstellen). Habe die Zeile entfernt, da das Makro auch vorher schon ohne Probleme gelaufen ist. nach ersten Tests hat es geklappt, habe das Makro jetzt gestartet, und es arbeitet seit einer halben stund e ohne Fehler. Ma kucken was dabei rauskommt. Danach kann ich eine Testdatei gerne hochladen, die Daten sind sowieso öffentlich im Internet zugänglich.
     
    ahalbeu, 28. Juni 2015
    #12
  13. fette Elfe Erfahrener User

    bestehendes Tabellenblatt-kopier-Makro auf Spalten-kopieren ändern

    Na da bin ich ja mal gespannt...
    denn wenn Du
    Code:
    oTargetBook.Worksheets.Add After:=Worksheets(oTargetBook.Worksheets.Count)
    entfernst, müsten Deine Daten immer in das selbe Blatt geschrieben, und somit jedesmal überschrieben werden...
    Übrigens hat diese Zeile bei mir keinerlei Probleme verursacht.
    ;O)
     
    fette Elfe, 28. Juni 2015
    #13
  14. ahalbeu Erfahrener User
    ... ähm ja...die Stunde Bearbeitungszeit hätte ich mir auch schnken könne wenn ich nicht so voreilig gewesen wäre.

    aber, wahrscheinlich hat das Makro funktioniert, da die Daten der letzen Quelldatei auf das Tabelenblatt kopiert wurden

    den Befehl habe ich erst auf dein anraten eingefügt, finden keinen gleichwertigen Befehl in meiner ursprungsdatei, die auch (wenn auch anders) funktionier hat. Oder ist in meinem Ursprungsmakro zwischenzeitlich "oTargetBook.Sheets.Count" das mein neu erstelltes sheet bevor es umbenannt wird?

    Quelldatei folgt
     
    Zuletzt bearbeitet: 28. Juni 2015
    ahalbeu, 28. Juni 2015
    #14
  15. fette Elfe Erfahrener User
    Hallo ahalbeu,

    ich denke ich habe den Fehler gefunden.
    Du hast den Code, den ich Dir vorgeschlagen habe, nicht 1 zu 1 übernommen, sondern die Reihenfolge der Codezeilen verändert.

    Mein Code:
    Code:
             Do While sDatei <> ""
    
             ' ein neues Arbeitsblatt in der Zieldatei erstellen (immer an letzter Stelle)
             oTargetBook.Worksheets.Add After:=Worksheets(oTargetBook.Worksheets.Count)
    
             'Schritt 3: öffnen der Datei und Datenübertragung
             Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True) 'nur lesend öffnen
             'Es wird immer das erste Tabellenblatt Sheets(1) kopiert!
    Dein Code:
    Code:
             Do While sDatei <> ""
    
             'Schritt 3: öffnen der Datei und Datenübertragung
             Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True) 'nur lesend öffnen
             ' ein neues Arbeitsblatt in der Zieldatei erstellen (immer an letzter Stelle)
             oTargetBook.Worksheets.Add After:=Worksheets(oTargetBook.Worksheets.Count)
             'Es wird immer das erste Tabellenblatt Sheets(1) kopiert!
    Der Unterschied ist klein aber fein.
    Sobald das Makro eine Datei öffnet, wird diese zum "ActiveWorkbook".
    Und sobald die Quelldatei geschlossen wird, sollte eigentlich die Zieldatei wieder den Focus erhalten.
    Somit ist bei Deinem Code die Zieldatei im Moment wo das neue Blatt erstellt wird, nicht die aktive Datei.
    Neue Arbeitsblätter in einer Datei hinzufügen klappt meines Wissens nach aber nur im "ActiveWorkbook" wirklich fehlerfrei.
    Warum der Fehler nicht immer, sondern nur ab und zu auftaucht weiß ich nicht, hatte das Problem aber selber schonmal.
    Eigentlich sollte es bei meiner Reihenfolge keine Probleme geben. Aber falls Du dann immernoch Fehlermeldungen bekommst, kannst Du folgendermaßen auf Nummer sicher gehen:
    Code:
          Do While sDatei <> ""
    
             ' ein neues Arbeitsblatt in der Zieldatei erstellen (immer an letzter Stelle)
             [COLOR=#ff0000]oTargetBook.Activate[/COLOR]
             oTargetBook.Worksheets.Add After:=Worksheets(oTargetBook.Worksheets.Count)
    
             'Schritt 3: öffnen der Datei und Datenübertragung
             Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True) 'nur lesend öffnen
             'Es wird immer das erste Tabellenblatt Sheets(1) kopiert!

    Damit es für Dich übersichtlicher wird, hier mal der komplette Code:
    Code:
    Sub kopie()
       Dim oTargetBook As Object
       Dim oSourceBook As Object
       Dim sPfad As String
       Dim sDatei As String
       Dim oFileDialog As FileDialog
    
         Application.ScreenUpdating = False 'Das "Flackern" ausstellen
         Application.DisplayAlerts = False 'Keine Fehlermeldungen anzeigen
    
         'Schritt 1: Arbeitsmappe festlegen, in die die neuen Sheets eingefügt werden...
         Set oTargetBook = ThisWorkbook
    
         'Wichtiger Hinweis: Die Arbeitsblätter dürfen nicht vorhanden sein!
         'Alternativer Umbau: Löschen evtl. bereits vorhandener Arbeitsblätter
    
         'Schritt 2: Schleife über alle Excel Dateien in einem Verzeichnis
         Set oFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
         With oFileDialog
            .Title = "Importverzeichnis wählen..."
            .ButtonName = "Import"
            If .Show = -1 Then sPfad = .SelectedItems(1)
         End With
         If Trim(sPfad) = "" Then GoTo Beenden
         If Right(sPfad, 1) <> "\" Then sPfad = sPfad & "\"
         sDatei = Dir(CStr(sPfad & "*.xl*")) 'Alle Excel Dateien
    
          Do While sDatei <> ""
    
             ' ein neues Arbeitsblatt in der Zieldatei erstellen (immer an letzter Stelle)
             oTargetBook.Activate
             oTargetBook.Worksheets.Add After:=Worksheets(oTargetBook.Worksheets.Count)
    
             'Schritt 3: öffnen der Datei und Datenübertragung
             Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True) 'nur lesend öffnen
             'Es wird immer das erste Tabellenblatt Sheets(1) kopiert!
             oSourceBook.Worksheets(1).Range("A:B").Copy
             oTargetBook.Worksheets(oTargetBook.Worksheets.Count).Range("A:B").PasteSpecial Paste:=xlPasteValues
             oSourceBook.Worksheets(1).Range("L:M").Copy
             oTargetBook.Worksheets(oTargetBook.Worksheets.Count).Range("L:M").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    
             'Es wird versucht den Dateinamen als Arbeitsblattnamen zu setzen.
             'Ist dieser bereits vorhanden wird der Fehler abgefangen und das neue Blatt
             'bekommt keinen anderen Namen und behält den typischen Namen Tabelle x
             On Error Resume Next
    
             'Arbeitsblattname wird der Dateiname
             oTargetBook.Worksheets(oTargetBook.Worksheets.Count).Name = Left(sDatei, InStrRev(sDatei, ".") - 1)
    
             'Wenn ein Fehler aufgetreten ist, wird dieser resettet
             If Err.Number <> 0 Then
                Err.Number = 0
                Err.Clear
             End If
             On Error GoTo 0
    
             'Schritt 4: Datei wieder zu machen und nächste Schleifenrunde
             oSourceBook.Close False 'nicht speichern
    
             'Nächste Datei
             sDatei = Dir()
    
         Loop
    
    Beenden:
         Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
         Application.DisplayAlerts = True 'Fehlermeldungen wieder anzeigen
         
         If Trim(sPfad) = "" Then Exit Sub
    
         'Kleine finale Fertig-Meldung
         MsgBox "Fertig!", vbInformation + vbOKOnly, "Hinweis!"
    
         'Variablen aufräumen
         Set oTargetBook = Nothing
         Set oSourceBook = Nothing
    End Sub
     
    fette Elfe, 28. Juni 2015
    #15
Thema:

bestehendes Tabellenblatt-kopier-Makro auf Spalten-kopieren ändern

Die Seite wird geladen...
  1. bestehendes Tabellenblatt-kopier-Makro auf Spalten-kopieren ändern - Similar Threads - bestehendes Tabellenblatt kopier

  2. Wert aus Zelle nehmen und bleibt bestehen

    in Microsoft Excel Hilfe
    Wert aus Zelle nehmen und bleibt bestehen: Hallo, Ich habe folgendes Problem. Ich möchte aus einer Lsite aus einem anderen Tabellenblatt werte filtern und in eine bestimmte liste einfügen wenn sie die Bedingungen erfüllen. Jedoch sollen...
  3. Excel Funktion, Ergebnis aus Zelle behalten obwohl Ursprungszelle entfernt wird

    in Microsoft Excel Hilfe
    Excel Funktion, Ergebnis aus Zelle behalten obwohl Ursprungszelle entfernt wird: Hallo, Ich habe folgendes Problem. Ich möchte aus einer Lsite aus einem anderen Tabellenblatt werte filtern und in eine bestimmte liste einfügen wenn sie die Bedingungen erfüllen. Jedoch sollen...
  4. VBA: Hinzufügen von Datensätzen zu einer bestehenden Tabelle

    in Microsoft Access Hilfe
    VBA: Hinzufügen von Datensätzen zu einer bestehenden Tabelle: Hallo, ich möchte zum ersten mal mit loop und einer Wenn-Bedingung mit VBA Datensätze (Felder) aus einer Tabelle in eine andere Tabelle übernehmen und komme nicht weiter. Vielleicht kann mir...
  5. Tabellenblatt in bestehende Datei kopieren

    in Microsoft Excel Hilfe
    Tabellenblatt in bestehende Datei kopieren: Hallo zusammen! Ich habe zu meinem Problem noch nichts hier gefunden und frag jetzt halt mal an. Also ich bin in einer Datei "x" und möchte nun das active Tabellenblatt in eine bereits...
  6. Export in bestehendes Tabellenblatt

    in Microsoft Access Hilfe
    Export in bestehendes Tabellenblatt: Hallo, ich versuche in ein bestehendes Excel-Worksheet/Tabellenblatt eine Abfrage von Access zu exportieren. Der Export funktioniert mit: Code: DoCmd.TransferSpreadsheet acExport,...
  7. Breakout Rooms in einem bestehenden Meeting

    in Microsoft Teams Hilfe
    Breakout Rooms in einem bestehenden Meeting: Liebe Community, ich habe eine Frage bzw. ein Problem: Ich würde gerne während eines laufenden Videomeetings zu Gruppenarbeiten übergehen - dazu bräuchte ich die Funktion "Breakout Rooms". Dazu...
  8. VBA Tabellenblatt aus bestehendem File kopieren, umbenennen und ans ende stellen

    in Microsoft Excel Hilfe
    VBA Tabellenblatt aus bestehendem File kopieren, umbenennen und ans ende stellen: Hallo zusammen, nachdem mir viele Tipps bisher aus diesem Forum geholfen haben, möchte ich mich erstmal bedanken :-) Ich habe mich jetzt hier registriert, da ich nicht weiterkomme. Ich...
  1. Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
    Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
    Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.
    Information ausblenden