|
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
29.09.2021 15:13:09 |
Albert |
|
|
 alle Tabellenblätter aus mehreren Dateien aus einem Ordner in eine neue Datei kopieren |
01.10.2021 10:48:21 |
volti |
|
|
|
02.10.2021 15:14:37 |
Albert Lind-Liedtke |
|
|
|
06.10.2021 15:35:10 |
Albert Lind |
|
|
Von:
volti |
Datum:
01.10.2021 10:48:21 |
Views:
233 |
Rating:
|
Antwort:
|
Thema:
alle Tabellenblätter aus mehreren Dateien aus einem Ordner in eine neue Datei kopieren |
|
Hallo Albert,
es fehlt mindestens ein "\" hinter der Pfadangabe, da sonst der letzte Teil als zum Dateinamen gehörend interpretiert wird.
Hier noch mal eine weitere Idee als Anregung aufgrund Deiner Vorgabemakros. Vieleicht hilft's:
Code:
01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50 |
|
Option Explicit
Sub Konsolidierung()
Dim sPfad As String, sDatei As String
Dim WKbQ As Workbook, WShZ As Worksheet
Dim oBer As Range
Dim i As Integer, iZeile As Long
Set WShZ = ThisWorkbook.Sheets("Konsolidierung") ' Zieltabelle festlegen
WShZ.Cells.Clear ' Altdaten löschen oder neues Blatt anlegen
sPfad = "C:\Users\voltm\Documents\Excel-Tabellen\"
sDatei = Dir(CStr(sPfad & "*.xl*")) ' Suchmaske festlegen
With Application
.ScreenUpdating = False ' Das "Flackern" ausstellen
.DisplayAlerts = False ' Keine Fehlermeldungen anzeigen
.EnableEvents = False
End With
' Alle Excel Dateien durchgehen
Do While sDatei <> ""
Set WKbQ = Workbooks.Open(sPfad & sDatei, False, True) ' nur lesend öffnen
' ----- Daten kopieren
For i = 2 To WKbQ.Worksheets.Count
With WKbQ.Worksheets(i).UsedRange
iZeile = WShZ.Cells(Rows.Count, 2).End(xlUp).Row + 1 ' Einfügezeile
Set oBer = .Range("A2:" & .Cells(.Rows.Count, .Columns.Count).Address)
WShZ.Range("A" & iZeile & ":A" _
& (oBer.Rows.Count + iZeile - 1)) _
= .Parent.Parent.Name & "!" & .Parent.Name ' Namen ausgeben
oBer.Copy Destination:=WShZ.Cells(iZeile, 2) ' Bereich kopieren
End With
Next i
' ----- Ende Daten kopieren
WKbQ.Close False ' Quelldatei nicht speichern
sDatei = Dir$
Loop
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
End With
MsgBox "Fertig!", vbInformation + vbOKOnly, "Hinweis!"
End Sub
|
_________
viele Grüße
Karl-Heinz
|
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Bitte geben Sie ein aussagekräftiges Thema an.
Bitte geben Sie eine gültige Email Adresse ein!
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
|
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
29.09.2021 15:13:09 |
Albert |
|
|
alle Tabellenblätter aus mehreren Dateien aus einem Ordner in eine neue Datei kopieren |
01.10.2021 10:48:21 |
volti |
|
|
|
02.10.2021 15:14:37 |
Albert Lind-Liedtke |
|
|
|
06.10.2021 15:35:10 |
Albert Lind |
|
|