Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
18.04.2024 18:04:29
Formel fehler Wert#
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1404to1408
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
1404to1408
1404to1408
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Tabellenblätter kopieren

Tabellenblätter kopieren
28.01.2015 20:15:16
Thomas
Hallo,
ich möchte gern von allen Excel- Arbeitsmappen, aus einem Ordner alle Arbeitsblätter in einer Arbeitsmappe rein kopieren. Im Netz habe ich schon einiges gefunden nur leider keins welches den Tabellen- Blattnamen beibehält. ( nicht den Name der Arbeitsmappe). Anschliessend soll das Macro die Orginalen Arbeitsmappen löschen ( wäre nur kompfort) Die Arbeitsblätter haben jeweils immer dass Datum als Format.(z.B. 25.01.15). Ziel ist es so zu sagen nach Macroausführung möchte ich die Tabellenblätter von einem ganzen Monat in einer Datei haben. Hier möchte ich dann mit Formeln weiter basteln.
Kann mir jemand Helfen?
Liebe Grüße Thomas

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
zum testen, Tabellen kopieren.
29.01.2015 17:59:28
Tino
Hallo,
kannst mal testen.
Das löschen der Dateien habe ich noch deaktiviert,
weil diese dann nicht mehr wiederhergestellt werden können.
Wenn Tabellen doppelt vorkommen, kommt es zum Fehler!
Pfad wo die Dateien liegen noch anpassen.
Sub Start()
Dim sOrdner$, sDir$
Dim varFile(), i%, ii%, iii%
Dim NewApp As Excel.Application, NewWB As Workbook, oWBEx As Workbook

sOrdner = "C:\Temp\" 'Ordner anpassen 

If Right$(sOrdner, 1) <> "\" Then sOrdner = sOrdner & "\"
sDir = Dir(sOrdner & "*.xls?", vbNormal)
Do While sDir <> ""
    Redim Preserve varFile(i)
    varFile(i) = sOrdner & sDir
    i = i + 1
    sDir = Dir()
Loop
If i = 0 Then Exit Sub

On Error GoTo ErrorHandler:

Set NewApp = New Excel.Application
Set NewWB = NewApp.Workbooks.Add

NewApp.DisplayAlerts = False
NewApp.Calculation = xlCalculationManual
NewApp.EnableEvents = False
NewApp.ScreenUpdating = False


With NewWB
    For i = Lbound(varFile) To Ubound(varFile)
        Application.StatusBar = "Bearbeite Datei " & i + 1 & " von " & Ubound(varFile) + 1
        Set oWBEx = NewApp.Workbooks.Open(varFile(i))
        For ii = 1 To oWBEx.Worksheets.Count
            If oWBEx.Worksheets(ii).Name Like "##.##.##" Then
                If iii = 0 Then
                    oWBEx.Worksheets(ii).Copy Before:=.Worksheets(1)
                    For iii = NewWB.Sheets.Count To 2 Step -1
                        .Sheets(iii).Delete
                    Next iii
                Else
                    oWBEx.Worksheets(ii).Copy After:=.Worksheets(.Worksheets.Count)
                End If
            End If
        Next ii
        oWBEx.Close False
'        Kill varFile(i) ' hier wird gelöscht ***************************** 
    Next i
End With

ErrorHandler:
Application.StatusBar = False
If Err.Number <> 0 Then MsgBox Err.Number & vbCr & vbCr & Err.Description, vbExclamation
On Error Resume Next

NewApp.DisplayAlerts = True
NewApp.Calculation = xlCalculationAutomatic
NewApp.EnableEvents = True
NewApp.ScreenUpdating = True

NewApp.Visible = True
End Sub
Gruß Tino

Anzeige
zum testen, Tabellen kopieren.
29.01.2015 20:54:11
Thomas
Hallo Tino
erstmal schon mal besten Dank für deine Mühe.
Leider kommt noch ein Fehler. " 8 Fehler beim Laden einer DLL ".
Debug kennzeichnet diese Zeile gelb an "NewApp.DisplayAlerts = True"
Kannst Du noch mal schauen?
Liebe Grüße
Thomas

habe den Code bei mir unter xl2010 getestet...
29.01.2015 21:07:42
Tino
Hallo,
kann auch keinen Fehler erkennen, in diesen Zusammenhang.
Gruß Tino

AW: habe den Code bei mir unter xl2010 getestet...
29.01.2015 21:56:00
Thomas
Hallo Tino
ich probiere es morgen auch mal unter 2010.
Habe hier leider keins.
Ich habe gerade noch gesehen das der Fehler noch sagt
" Laufzeitfehler 91 Objektvariable oder Wiht-Blockvariable nicht festgelegt.
Ich melde mich dann
Liebe Grüsse
Thomas

Anzeige
Hallo Tino
30.01.2015 08:10:37
Thomas
Hallo Tino,
unter Office 2010 läuft das Macro auch bei mir.
Hast Du eine Idee wie man dies umschreibt auf office 2007? Wenn nicht besorge ich mir Office 2010 ich werde dann bestimmmt öfter auf so ein Problem stoßen.
Eine kleine Verbesserung wäre noch Cool. Kannst Du das so umschreiben das die Datein in der Arbeitsmappe landen von der aus das Macro gestartet wird? Möglich wäre auch das eine Abfrage kommt in welche Datei die Mappen landen sollen ( das erste wäre aber besser ).
Lieben dank, nicht nur für deine Arbeit sondern auch für dein Interesse.
Thomas

vielleicht kann einer mit xl2007 testen
30.01.2015 12:10:47
Tino
Hallo,
kann mir nicht so recht vorstellen das es unter 2007 nicht geht.
Werden nur Standard Aktionen verwendet.
Gruß Tino

Anzeige
Hallo Tino
30.01.2015 12:40:17
Thomas
Hallo Tino,
schaust Du bitte trotzdem mal ob man das mit dem speichern hinbekommen kann? So das das Macro nicht immer eine neue Datei anlegt? Super wäre wenn die Zieldatei die gleiche ist, von der aus man das Macro startet.
unabhängig von der Office Version.
Gruß
Thomas

Hallo Tino gelöst
31.01.2015 02:14:35
Thomas
Hallo Tino,
ich wollte nur bescheid geben das ich eine Lösung für dieses Problem gefunden habe.
Das Macro laüft jetzt. Beste dank noch mal. Ich habe zwar jetzt ein neues Problem damit, aber dafür habe ich ein neuen Beitrag eröffnet.
Vieleicht schaust Du dir dies auch mal an.
Liebe Grüße
Thomas
Anzeige

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige