Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
828to832
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
828to832
828to832
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Daten aus verschiedenen Arb.Mappen in eine Tabelle

Daten aus verschiedenen Arb.Mappen in eine Tabelle
18.12.2006 10:39:19
Sören
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

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten aus verschiedenen Arb.Mappen in eine Tabelle
18.12.2006 12:53:04
Fritz
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

Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige