Hallo Zusammen,
ich suche eine Lösung ähnlich der Beschreibung zu „mehrere Excel Tabellen zusammenführen“.
Allerdings benötige ich eine Lösung die Inhalte mehrerer Excel Dateien die immer gleich aufgebaut sind in eine Tabelle zusammenzufassen.
Leider bekomme ich das Problem als VB-Script Anfänger nicht selbst gelöst und wäre euch sehr dankbar wenn Ihr mir hierbei weiterhelfen könnetet?!
Vielen Dank schon mal im vorraus
Grüße Frank
Hallo Frank,
ich suche eine Lösung ähnlich der Beschreibung zu „mehrere
Excel Tabellen zusammenführen“.
was geanu meinst du damit?
Allerdings benötige ich eine Lösung die Inhalte mehrerer
Excel Dateien die immer gleich aufgebaut sind in eine Tabelle
zusammenzufassen.
Ich hab jetzt mal kurz den Code von hier:
http://www.wer-weiss-was.de/article/6344078
ungetestet umgeschrieben, teste ihn und berichte. Was dort im Artikel steht gilt auch hier.
Gruß
Reinhard
Option Explicit
Sub XLSEinlesen()
Dim fs As FileSearch, ZeiQ As Long, ZeiZ As Long, F As Integer
Dim wksQ As Worksheet, wksZ As Worksheet
Set wksZ = ThisWorkbook.Worksheets("Tabelle1") 'Anpassen
Set fs = Application.FileSearch
On Error GoTo hell
Call Loesch
Application.ScreenUpdating = False
With fs
.LookIn = "C:\test" 'Anpassen
.SearchSubFolders = False 'Anpassen
.Filename = "\*.xls"
If .Execute() \> 0 Then
For F = 1 To .FoundFiles.Count
ZeiZ = wksZ.Cells(Rows.Count, 1).End(xlUp).Row + 1
If ZeiZ = 2 Then ZeiZ = 1
Workbooks.Open .FoundFiles(F)
ZeiQ = ActiveWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
ActiveWorkbook.Worksheets(1).Rows("1:" & ZeiQ).Copy Destination:=wksZ.Cells(ZeiZ, 1)
Next F
Else
MsgBox "There were no xls files found in c:\test."
End If
'Call Loesch
End With
hell:
If Err.Number 0 Then
MsgBox ActiveWorkbook.Name & vbCr & Err.Number & vbCr & Err.Description
End If
Application.ScreenUpdating = True
End Sub
Sub Loesch()
Dim wkb As Workbook
Application.ScreenUpdating = False
For Each wkb In Workbooks
If wkb.Name ThisWorkbook.Name And UCase(wkb.Name) "PERSONL.XLS" Then
wkb.Close savechanges:=False
End If
Next wkb
Application.ScreenUpdating = True
End Sub
Hallo Reinhard,
Vielen Dank für deine Hilfe
Grüße Frank