Bettman
Diskussionsleiter
Profil anzeigen
Private Nachricht
Link kopieren
Lesezeichen setzen
dabei seit 2009
Profil anzeigen
Private Nachricht
Link kopieren
Lesezeichen setzen
Viele Exceldokumente in ein Dokument legen
31.07.2016 um 12:44Hallo allerseits,
da meine Excelkenntnisse nicht gerade das gelbe vom Ei sind, bin ich mal wieder auf etwas Hilfe angewiesen. :D
Ich habe enorm viele Exeldokumente, welche alle den selben Aufbau haben (gleiche Spaltenanzahl, gleicher Spaltenname, gleiche Überschriften, nur unterschiedliche Daten).
Jedes dieser Exceldokumente besteht aus nur einem Blatt. Ich möchte nun immer 30 dieser Dokumente in einem Dokument so zusammenfassen, dass jedes Dokument in dem neuen ein eigenes Blatt ist.
Oder anders ausgedrückt: Ich möchte die Blätter der einzelnen Dokumente (jeweils ein Blatt pro Dokument) in einem einzigen Dokument zusammenfassen.
Ich könnte zwar einfach die Blätter per Hand in die Neue Mappe verschieben, habe allerdings um die 100 Ordner mit jeweils 30 Dokumenten die zusammengefasst werden sollen. Daher schwebt mir eine Lösung mit der Hilfe von Makros am meisten vor. Leider hat es trotz mehrmaliger Versuche nicht geklappt ein solches Makro aufzuzeichnen.
Daher habe ich mich etwas im Netz umgeschaut und bin in einem anderen Forum auf folgendes Makro gestoßen:
SpoilerOption Explicit
Public Sub SearchFileAndCopySheet()
Dim objFS As FileSearch
Dim objFO As Object
Dim objWb As Workbook, objNew As Workbook
Dim strPath As String
Dim intIndex As Integer
On Error GoTo ErrExit
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
.Cursor = xlWait
End With
strPath = "F:\Temp" 'Pfad - Anpassen!
If Right(strPath, 1) "\" Then strPath = strPath & "\"
Set objFS = Application.FileSearch
Set objFO = CreateObject("Scripting.FileSystemObject")
Set objNew = Workbooks.Add(xlWBATWorksheet)
With objFS
.NewSearch
.LookIn = strPath
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = False
If .Execute > 0 Then
For intIndex = 1 To .FoundFiles.Count
Set objWb = Workbooks.Open(.FoundFiles(intIndex))
objWb.Sheets(1).Copy after:=objNew.Sheets(objNew.Sheets.Count)
objNew.Sheets(objNew.Sheets.Count).Name = objFO.GetBasename(.FoundFiles(intIndex))
objWb.Close False
Set objWb = Nothing
Next
End If
End With
objNew.Sheets(1).Delete
objNew.SaveAs strPath & "Zusammenfassung.xls"
ErrExit:
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.Cursor = xlDefault
End With
Set objNew = Nothing
Set objFS = Nothing
Set objFO = Nothing
End Sub
Quelle: http://www.herber.de/forum/archiv/716to720/718726_Viele_Excel_Dateien_zu_einer_zusammenfuehren.html
Leider kann ich aufgrund meiner kaum vorhandenen Makrokentnisse auch mit diesem Code relativ wenig anfangen :( Das Anpassen der Pfade bekomme ich gerade noch so hin. Aber dann hört es schon auf bei mir. Wo muss ich den Quelltext denn dann einkopiere damit Excel mir dieses Makro abarbeitet und was muss ich sonst noch beachten? Dazu konnte ich bisher noch nichts hilfreiches finden.
Es wäre sehr schön, wenn mir da mal jemand ein paar Tipps geben könnte.
Für Antworten und Hilfe bedanke ich mich schon einmal im Vorraus.
lg dorfschamane
Anzeige
da meine Excelkenntnisse nicht gerade das gelbe vom Ei sind, bin ich mal wieder auf etwas Hilfe angewiesen. :D
Ich habe enorm viele Exeldokumente, welche alle den selben Aufbau haben (gleiche Spaltenanzahl, gleicher Spaltenname, gleiche Überschriften, nur unterschiedliche Daten).
Jedes dieser Exceldokumente besteht aus nur einem Blatt. Ich möchte nun immer 30 dieser Dokumente in einem Dokument so zusammenfassen, dass jedes Dokument in dem neuen ein eigenes Blatt ist.
Oder anders ausgedrückt: Ich möchte die Blätter der einzelnen Dokumente (jeweils ein Blatt pro Dokument) in einem einzigen Dokument zusammenfassen.
Ich könnte zwar einfach die Blätter per Hand in die Neue Mappe verschieben, habe allerdings um die 100 Ordner mit jeweils 30 Dokumenten die zusammengefasst werden sollen. Daher schwebt mir eine Lösung mit der Hilfe von Makros am meisten vor. Leider hat es trotz mehrmaliger Versuche nicht geklappt ein solches Makro aufzuzeichnen.
Daher habe ich mich etwas im Netz umgeschaut und bin in einem anderen Forum auf folgendes Makro gestoßen:
SpoilerOption Explicit
Public Sub SearchFileAndCopySheet()
Dim objFS As FileSearch
Dim objFO As Object
Dim objWb As Workbook, objNew As Workbook
Dim strPath As String
Dim intIndex As Integer
On Error GoTo ErrExit
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
.Cursor = xlWait
End With
strPath = "F:\Temp" 'Pfad - Anpassen!
If Right(strPath, 1) "\" Then strPath = strPath & "\"
Set objFS = Application.FileSearch
Set objFO = CreateObject("Scripting.FileSystemObject")
Set objNew = Workbooks.Add(xlWBATWorksheet)
With objFS
.NewSearch
.LookIn = strPath
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = False
If .Execute > 0 Then
For intIndex = 1 To .FoundFiles.Count
Set objWb = Workbooks.Open(.FoundFiles(intIndex))
objWb.Sheets(1).Copy after:=objNew.Sheets(objNew.Sheets.Count)
objNew.Sheets(objNew.Sheets.Count).Name = objFO.GetBasename(.FoundFiles(intIndex))
objWb.Close False
Set objWb = Nothing
Next
End If
End With
objNew.Sheets(1).Delete
objNew.SaveAs strPath & "Zusammenfassung.xls"
ErrExit:
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.Cursor = xlDefault
End With
Set objNew = Nothing
Set objFS = Nothing
Set objFO = Nothing
End Sub
Quelle: http://www.herber.de/forum/archiv/716to720/718726_Viele_Excel_Dateien_zu_einer_zusammenfuehren.html
Leider kann ich aufgrund meiner kaum vorhandenen Makrokentnisse auch mit diesem Code relativ wenig anfangen :( Das Anpassen der Pfade bekomme ich gerade noch so hin. Aber dann hört es schon auf bei mir. Wo muss ich den Quelltext denn dann einkopiere damit Excel mir dieses Makro abarbeitet und was muss ich sonst noch beachten? Dazu konnte ich bisher noch nichts hilfreiches finden.
Es wäre sehr schön, wenn mir da mal jemand ein paar Tipps geben könnte.
Für Antworten und Hilfe bedanke ich mich schon einmal im Vorraus.
lg dorfschamane
nun an einer beliebigen stelle im Excelsheet einen Button platzieren bzw. 'aufziehen'