Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 12:28:32
Formelfehler aufgrund Einfügen einer Zeile
18.04.2024 11:51:04
Aus Listbox Spalte als Wert zurück bekommen
18.04.2024 11:36:51
Beim Öffnen je nach Datum zu bestimmter Zelle springen
18.04.2024 11:16:38
Pfade werden mit Anführungszeichen "" versehen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1500to1504
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1500to1504
1500to1504
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Tabellenblätter aus Dateien löschen

Tabellenblätter aus Dateien löschen
21.06.2016 15:13:58
Bernd
Hallo zusammen,
ich bekomme täglich eine Datenlieferung, die aus 4 Exceldatein besteht, die wiederum jeweils ca. ein Dutzend Tabellenblätter enthalten. Ich benötige jedoch nur das letzte Tabellenblatt aus jeder Datei. Diese 4 Blätter sollen in eine eigene Exceldatei kopiert werden, von der aus ich auch dieses Import-Makro starten möchte. Die Quelldatein und die Zieldatei liegen im gleichen Verzeichnis. Wie muss der Code lauten?
Viele Grüße und Dank im Voraus für Eure Hilfe....
Bernd

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Nachfrage..
21.06.2016 15:22:00
UweD
Hi
sollen die Tabellenblätter in der Zieldatei immer zugefügt werden?
oder werden bestehende sheets genutzt (vorher löschen)

AW: Nachfrage..
21.06.2016 15:29:49
Bernd
Hallo,
dafür habe ich schon einen funktionierenden Code, zufügen müsste reichen.
Viele Grüße
Bernd

AW: Nachfrage..
21.06.2016 15:56:22
UweD
Hallo nochmal
so könnte es klappen...
Sub Verschieben()
    Dim Pfad$, Ext$, Datei$
    Dim WB1, WB2
    Set WB1 = ThisWorkbook
    Ext = "*.xls*"
    Pfad = "C:\Temp\Test\"
    Datei = Dir(Pfad & Ext)
    Do While Len(Datei) > 0 And Datei <> WB1.Name
        Set WB2 = Workbooks.Open(Filename:=Pfad & Datei)
        WB2.Sheets(Sheets.Count).Copy After:=WB1.Sheets(Sheets.Count)
        WB2.Close False
        'Kill Pfad & Datei 'Wenn gelöscht werden soll 
        
        Datei = Dir() ' nächste Datei 
    Loop

End Sub


VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 15 - mit VBAHTML 12.6.0
Gruß UweD

Anzeige
AW: Nachfrage..
21.06.2016 16:24:58
Bernd
Hallo,
ich erhalte leider einen Laufzeitfehler 9: Index außerhalb des gültigen Bereiches. Der Code häkt bei:
WB2.Sheets(Sheets.Count).Copy After:=WB1.Sheets(Sheets.Count)

AW: Nachfrage..
21.06.2016 16:27:41
UweD
Speicher die Datei einmal ab

AW: Nachfrage..
22.06.2016 09:18:20
Bernd
Hallo,
das hat leider nichts gebracht. Vielleicht noch folgender Hinweis: Wenn, ich den Pfad hinterlege und das Makro in der Zieldatei ausführer, passiert gar nichts. Wenn ich den Pfad im Code deaktiviere, kommt die besagte Fehlermeldung und außerdem öffnet sich eine der Quelldateien im Hintergrund. Kommt das Makro vielleicht mit den Importdateien nicht klar? Die betreffende Datei hat z. b. 29 Sheets und nur das letzte soll in die Zieldatei übertragen werden.

Anzeige
AW: Nachfrage..
22.06.2016 09:43:05
UweD
Hallo
außerdem öffnet sich eine der Quelldateien im Hintergrund: das soll so sein
Kommt das Makro vielleicht mit den Importdateien nicht klar? Die betreffende Datei hat z. b. 29 Sheets und nur das letzte soll in die Zieldatei übertragen werden.: das dürfte kein Problem sein
Die Fehlermeldung trat bei mir "NUR" auf, als die Datei noch nicht gespeichert hatte.
Lad doch mal 2 Musterdateien hoch (1 x Quell und die Zieldatei, mit dem eingebauten Makro)
LG UweD

AW: Nachfrage..
22.06.2016 13:28:25
Bernd
Hallo nochmal,
leider kann ich die Quelldaten nicht hochladen, da zu sensibel. Ich habe mal mit anderen Quelldaten getestet und es hat problemlos funktioniert. Bisher habe ich Dateien nur mit einem Sheet angeliefert bekommen und der Import hat funktioniert. Nun bekomme ich das Sheet in verschiedenen Varianten (Aufbau und Formatierung ist aber identisch) und ich benötige wie bisher nur eines davon. Der Codem den ich verwendet habe war auszugsweise wie folg, vielleicht lässt sich davon was "ableiten":
Sub Import_und_Blattnamen_anpassen()
Dim strDatnam As String
Dim wb As Workbook
Dim Ws As Worksheet
Dim strPath As String
Application.ScreenUpdating = False
strPath = ActiveWorkbook.Path
strDatnam = Dir(strPath & "\*.xls")
Do While Len(strDatnam)
Set wb = Workbooks.Open(strDatnam)
Set Ws = ThisWorkbook.Sheets.Add
Ws.Name = Split(strDatnam, Application.PathSeparator)(UBound(Split(strDatnam, Application. _
PathSeparator)))
wb.Sheets(1).Cells.Copy Destination:=Ws.Cells
wb.Close savechanges:=False
strDatnam = Dir
Loop
Set Ws = Nothing
Set wb = Nothing
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Nachfrage..
22.06.2016 14:16:22
UweD
Hallo
du Kopierts aber nicht das Blatt von .. nach,
sondern die Inhalte des Blattes auf ein neu erstelltes Blatt.
Das geht natürlich auch.
habs auf das letzte Blatt abgeändert. Auch werden die Blätter immer hinten angehangen.
Option Explicit

Sub Import_und_Blattnamen_anpassen()
    Dim strDatnam As String
    Dim wb As Workbook
    Dim Ws As Worksheet
    Dim strPath As String
    
    Application.ScreenUpdating = False
    strPath = ActiveWorkbook.Path
    strDatnam = Dir(strPath & "\*.xls")
    Do While Len(strDatnam)
       If strDatnam <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(strDatnam)
            Set Ws = ThisWorkbook.Sheets.Add(after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
            Ws.Name = Split(strDatnam, Application.PathSeparator) _
                (Ubound(Split(strDatnam, Application. _
                PathSeparator)))
            wb.Sheets(wb.Sheets.Count).Cells.Copy Destination:=Ws.Cells
            wb.Close savechanges:=False
       End If
       strDatnam = Dir
    Loop
    Set Ws = Nothing
    Set wb = Nothing
    Application.ScreenUpdating = True
End Sub


VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 15 - mit VBAHTML 12.6.0
Gruß UweD

Anzeige
Danke! Klappt nun perfekt!
23.06.2016 10:54:31
Bernd
Bestens!
Vielen Dank
Bernd

AW: gern geschehen owt
23.06.2016 11:12:01
UweD

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige