Herbers Excel-Forum - das Archiv

Sheet aus File kopieren und in zig andere einfügen

Bild

Betrifft: Sheet aus File kopieren und in zig andere einfügen
von: Bastian Eberl

Geschrieben am: 29.07.2008 16:55:53

Guten Abend,
ich bin mal wieder absolut rat und hilflos.
Ich habe im Büro einen ganz "tollen" Auftrag bekommen.
Wir haben identisch formatierte (alle inhalte jeweils an der gleichen stelle in der file) excel files. Nun soll ich die "hübsche" Daten so zusammen tragen, dass man daraus eine Pivot-Tabelle mit den inhalten aller Files erzeugen kann.
Hierzu habe ich mir folgendes überlegt.
1. Schritt: erzeugen eines neuen Sheets in dem die benötigten werde nebeneinander bzw. untereinander eingetragen werden: (='Tabelle1'!A1).
2. Dieses Sheet in sämtliche Dateien (sind weit über 300) manuel kopieren und die Bezüge ändern
3. Macro darüber laufen lassen, dass die alle Werte aus den 300 einzelnen Dateien untereinander einfügt und nur die Werte übrig lässt.
4. Pivot tabelle erzeugen.
Zu Schritt 1: Das ist sicher Handarbeit. Das muss man halt einmal machen.
Zu Schritt2: Geht das über ein Makro? Also das neu erzeugte Tabellenblatt automatisch (mit den entsprechend angepassten bezhügen) in alle Files zu kopieren?
Zu Schritt3: Hier habe ich im Forum schon ein Makro gebastelt bekommen (hier nochmals TAUSEND DANK dafür) gefunden
option Explicit

Sub Lese_Excel_Daten()
Dim meDatei As Workbook
Dim FName$, strPfad$
Dim oData As DataObject
Dim Anzahl As Long
Const PassTabelle As String = "test" 'Passwort Tabelle
Const PassDatei As String = "test" 'Passwort Datei
strPfad = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\") _
On Error GoTo goError
'Pfad angeben und Art der datei *.xls oder *.xlsm oder *.xlsx usw.
FName = Dir(strPfad & "*.xls")
EventAusAn False
ThisWorkbook.Sheets(Tabelle1.Name).Cells.ClearContents
'Schleife über alle Dateien in diesem Ordner
Set oData = New DataObject
While FName <> ""
If FName <> ThisWorkbook.Name Then
'öffne Datei
Set meDatei = Workbooks.Open(strPfad & FName, , , , PassDatei, PassDatei)
'Tabelle zuordnen
With meDatei.Sheets("datat")
meDatei.Unprotect PassTabelle
'Tabelle sichtbar machen
.Visible = True
'schutz aufheben, eventuell nicht erforderlich
.Unprotect PassTabelle
'Kopiere A2:p20
.Range("A2:P20").Copy
End With
'Einfüge Datei und Tabelle
With ThisWorkbook.Sheets(Tabelle2.Name)
'Füge ab der nächsten Freien Zelle in Spalte A ein
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End With
'Datei ohne Speichern schließen
Application.CutCopyMode = False
oData.Clear
meDatei.Close False
Anzahl = Anzahl + 1
End If
'nächste Datei im Ordner
FName = Dir()
Wend
goError:
ThisWorkbook.Activate
Sheets(Tabelle1.Name).Select
Range("A1").Select
Set oData = Nothing
EventAusAn
If Err.Number <> 0 Then
MsgBox "Error!" & Chr(13) & Err.Description
Else
MsgBox "" & Anzahl & " files are updated!"
End If
End Sub


Sub EventAusAn(Optional Zustand As Boolean = True)
Static ZustandAlt As Long
If Zustand = False Then ZustandAlt = Application.Calculation
With Application
.EnableEvents = Zustand
.ScreenUpdating = Zustand
.DisplayAlerts = Zustand
.Calculation = IIf(Zustand = True, ZustandAlt, xlCalculationManual)
End With
End Sub


Das sollte eigentlich gehen, oder zumindest auf meine Bedürfnisse anpassbar sein.
Zu Punkt 4. kein problem...
Aber Punkt 2 macht mir echte Sorgen.
Ist jemand von Euch in der Lage und auch noch bereit, mir ein Makro zu schreiben mit dem Punkt 2 abgedeckt ist, also ein Makro, dass es schafft von Musterdatei.xls das sheet "mustersheet" zu kopieren und in alle Files eines Ordners einzufügen und jeweils die Bezüge auf die Datei anzupassen?
Das wäre wirklich superprima!!!
Vielen Dank und viele Grüsse
Bastian

Bild

Betrifft: AW: Daten aus vielen Mappen sammeln
von: Erich G.

Geschrieben am: 29.07.2008 19:39:17
Hallo Bastian,
dieses Vorgehen - insbesondere Schritt 2 - scheint mir "suboptimal" zu sein.
Was du brauchst, ist doch nur eine "Sammel"-Mappe, in der alle auszuwertenden Daten zusammengeführt werden.
Dazu musst du doch nicht 300 Dateien ändern.
Ich würde das so vorschlagen:
Neue "Sammel"-Mappe anlegen, mit einem Blatt
In einer Schleife alle relevanten Daten aus den 300 Dateien in das Blatt übertragen
Pivot erstellen.
Für das Übertragen sind vielleicht ein paar mehr Codezeilen nötig.
Das sollte aber weniger Aufwand machen als die Änderung der 300 Mappen.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Bild

Betrifft: AW: Sheet aus File kopieren und in zig andere einfügen
von: Daniel

Geschrieben am: 29.07.2008 20:00:16
Hi
prinzipiell ist es so, daß das Lesen von Daten aus geschlossenen Dateien recht langsam ist.
wenn die Dateien nicht allzugross sind, dann ist es oft besser, die Dateien nacheinander zu öffen und die benötigten Daten in die Masterdatei zu kopieren.
das hat den Vorteil daß du die einzelnen Dateien nicht verändern musst
das folgende Makro z.B. sucht sich aus allen Excelfiles des angegeben Verzeichnisses die Zelle A1 des ersten Sheets:
Pfad = ThisWorkbook.Path
ThisWorkbook.Sheets(1).Cells.ClearContents
Datei = Dir(Pfad & "\*.xls")
Application.ScreenUpdating = False
Do Until Datei = ""
If Datei <> ThisWorkbook.Name Then
Workbooks.Open Pfad & "\" & Datei, ReadOnly:=True, UpdateLinks:=0
With ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp)
.Offset(1, 0).Value = Datei
.Offset(1, 1).Value = ActiveWorkbook.Sheets(1).Cells(1, 1).Value
End With
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
End If
Datei = Dir()
Loop
Application.ScreenUpdating = True
End Sub
Gruß, Daniel

Bild

Betrifft: AW: Sheet aus File kopieren und in zig andere einfügen
von: Daniel

Geschrieben am: 29.07.2008 20:01:15
Hi
prinzipiell ist es so, daß das Lesen von Daten aus geschlossenen Dateien recht langsam ist.
wenn die Dateien nicht allzugross sind, dann ist es oft besser, die Dateien nacheinander zu öffen und die benötigten Daten in die Masterdatei zu kopieren.
das hat den Vorteil daß du die einzelnen Dateien nicht verändern musst
das folgende Makro z.B. sucht sich aus allen Excelfiles des angegeben Verzeichnisses die Zelle A1 des ersten Sheets:

Sub einlesen()
Dim Pfad As String
Dim Datei As String
Pfad = ThisWorkbook.Path
ThisWorkbook.Sheets(1).Cells.ClearContents
Datei = Dir(Pfad & "\*.xls")
Application.ScreenUpdating = False
Do Until Datei = ""
If Datei <> ThisWorkbook.Name Then
Workbooks.Open Pfad & "\" & Datei, ReadOnly:=True, UpdateLinks:=0
With ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp)
.Offset(1, 0).Value = Datei
.Offset(1, 1).Value = ActiveWorkbook.Sheets(1).Cells(1, 1).Value
End With
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
End If
Datei = Dir()
Loop
Application.ScreenUpdating = True
End Sub


Gruß, Daniel

Bild

Betrifft: AW: Sheet aus File kopieren und in zig andere einfügen
von: Bastian Eberl
Geschrieben am: 30.07.2008 10:49:16
Hallo ihr zwei,
vielen dank für die schnelle hilfe.
das projekt hat sich zum glück erledigt.
dennoch tausend dank für eure hlfe.
viele grüsse
bastian

 Bild
Excel-Beispiele zum Thema "Sheet aus File kopieren und in zig andere einfügen"
Blätter in andere Arbeitsmappen kopieren Module von Mappe zu Mappe kopieren
Arbeitsblatt 40 mal kopieren Schriftgröße beim Kopieren verdoppeln
Beim Kopieren auch die Zeilenhöhe und Spaltenbreite übernehmen Tabellencode nach Kopieren des Blattes löschen
Arbeitsmappe blitzschnell kopieren VBE-Namen der Blattmodule beim Kopieren festlegen
Blattinhalt von einer zur anderen Arbeitsmappe kopieren Formel bis zur letzten Zeile der Nebenspalte kopieren