Herbers Excel-Forum - das Archiv

Daten aus verschiedenen Arb.Mappen in eine Tabelle

Bild

Betrifft: Daten aus verschiedenen Arb.Mappen in eine Tabelle
von: Sören

Geschrieben am: 18.12.2006 10:39:19
Hallo an alle im Forum,
ich benötige mal wieder eure Hilfe.
Und zwar habe ich einen Ordner mit verschiedenen Arbeitsmappen. (Jede Arbeitsmappe besteht aus 3 Tabellenblättern, wobei nur das erste jeweils benutzt wird.) Dieses Tabellenblatt ist eine Rechnung und in den Zellen B1 - B7 stehen die Adressdaten. Jetzt muss ich die einzelnen Adressen in einer neuen Tabelle zusammenfassen. Kennt jemand dafür einen Makro?
Vielen Dank
Sören
Bild

Betrifft: AW: Daten aus verschiedenen Arb.Mappen in eine Tabelle
von: Fritz Hellbach

Geschrieben am: 18.12.2006 12:53:04
Hallo Sören,
vielleicht hilft dir dies weiter.
Die Pfade musst Du natürlich noch anpassen und die Datei, die Du bearbeitest, also die neue, darf nicht im gleiche Ordner stehen, wie die zu lesenden Dateien.
Gruß Fritz
Option Explicit
Declare
Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _
ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Declare 
Function FindNextFile Lib "kernel32" Alias "FindNextFileA" ( _
ByVal hFindFile As Long, _
lpFindFileData As WIN32_FIND_DATA) As Long
Declare 
Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Const MAX_PATH = 260
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Sub xx()
Dim I&, J&, LZ&
Dim FoundFileNames() As String
Dim Ws1 As Worksheet
Dim WbTmp As Workbook
Dim WsTmp As Worksheet
Dim hFind&, hFile&, nFile&
Dim FD As WIN32_FIND_DATA
Dim PathName$, Pattern$
PathName = "D:\temp\herber\"        'Pfadname der Excel-Dateien
Pattern = "*.xls"                   ' Dateiendung
Set Ws1 = ActiveWorkbook.ActiveSheet
LZ = Ws1.Cells.SpecialCells(xlCellTypeLastCell).Row
'Alle Excel-Dateien ermitteln
ReDim FoundFileNames(0)
hFile = FindFirstFile(PathName & Pattern, FD)
If hFile > 0 Then
FoundFileNames(UBound(FoundFileNames)) = PathName & ClearFileName(FD.cFileName)
ReDim Preserve FoundFileNames(UBound(FoundFileNames) + 1)
Do
nFile = FindNextFile(hFile, FD)
If nFile > 0 Then
FoundFileNames(UBound(FoundFileNames)) = PathName & ClearFileName(FD.cFileName)
ReDim Preserve FoundFileNames(UBound(FoundFileNames) + 1)
End If
Loop While nFile <> 0
End If
FindClose hFile
'Verarbeitung starten
For I = 0 To UBound(FoundFileNames) - 1
Set WbTmp = Workbooks.Open(FoundFileNames(I))
Set WsTmp = WbTmp.Sheets(1)
For J = 1 To 7
Ws1.Cells(LZ + 1, J) = WsTmp.Cells(J, 2)
Next
Set WsTmp = Nothing
WbTmp.Close
LZ = LZ + 1
Next
End Sub

Function ClearFileName(CDat)
Dim X&
X = InStr(1, CDat, Chr$(0))
If X > 0 Then
ClearFileName = Trim$(Left$(CDat, X - 1))
Exit Function
End If
ClearFileName = ""
End Function

 Bild
Excel-Beispiele zum Thema "Daten aus verschiedenen Arb.Mappen in eine Tabelle"
Verstreute Daten in verschiedenen Tabellen zusammenfassen CommandButtons in verschiedenen Tabellen mit einem Makro
Synchronisieren von Optionsfeldern in verschiedenen Blättern Anzahl von Werten nach verschiedenen Bedingungen.
Aus verschiedenen Zellwerten zusammengesetzte Webadresse aufrufen Wert aus Optionsfelder in verschiedenen Frames auslesen
Darstellung der verschiedenen Erscheinungsformen von LixtBoxes Suche über mehrere Tabellen
Benennen von Tabellenblättern mit Monatsnamen Druckseitenlinien im Tabellenblatt