Makro Zusammenführung Dateien in Excel *verzweifel*

Question

Ein herzliches Hallo an die Excel-Profis ...

Ich bin schon seit einigen Stunden am Recherchieren und finde irgendwie doch nicht das Passende, obwohl so viele Möglichkeiten angeboten werden. Aber alles was ich ausprobiert habe funzt net so recht - bin leider ziemlicher VBA-Laie. Ich hoffe auf Eure Unterstützung.

Zum Thema:

Ich habe in einem bestimmten Ordner x Dateien - um genau zu sein, Adresslisten mit zig Spalten (Name, Firma, Tel#, Fax#, Mailadressen, Ansprechpartner und diverse Spalten mit Eintragungen zu verschiedenen Versandaktionen), die ständig aktualisiert werden (Zeilen, als auch Spalten - Zeile 1 enhält immer Überschriften und das darin enthaltene Tabellblatt hießt immer "Adressen"). Die Anzahl der Zeilen und Spalten variiert zwischen den Dateien - Anzahl Spalten 30 - 40, Anzahl Zeilen 63 - 1300.

Der Inhalt der Dateien soll nacheinander vollständig in einer neuen MASTER-Mappe zusammengefasst werden - und sich beim Öffnen immer automatisch aktualisieren. Sicherlich ist hier ein Makro von Nöten ... aber WIE????

Die Krönung dessen ist, dass die Dateien teilweise gleiche oder ähnliche Datensätze enthalten. Beispiel: In einer Datei wird Typ A zu Veranstaltung A eingeladen (Spalte Veranstaltung A mit "x" in Zeile Typ A), in einer anderen Datei wird Typ A zu Veranstaltung B eingeladen (Spalte Veranstaltung B mit "x" in Zeile Typ A) - noch alles klar ;o).
Die Master-Mappe sollte also am besten nach Namen sortiert sein. Und wenn man solche "Vorname-Nachname-Doppler" noch irgendwie gekennzeichnet bekäme - das wäre der HIT.

Kann man in einem Makro eigentlich auch hinterlegen, dass bestimmte Spalten (also B - D, G, K - M) in der Master-Mappe ausgeblendet werden sollen? Die Master-Mappe soll zwar vollständig sein, aber dem guten Handling halber in der Ansicht komprimiert.

Die entstandene Master-Mappe soll eben zum Abgleich von Adressen und auch zur Erstellung von Serienbriefen etc. dienen (Filterfunktion).

So ... ich hoffe ich habe nichts vergessen und Ihr könnt mir helfen.

Liebe Grüße von
Betsy.dd

Answer 1

hi Betsy ^^

ein anfang :-)

probier mal das :-)

gruss nighty

pfad ist an 2 stellen anzupassen

der gesamte code gehoert in ein allgemeines modul

alt+f11/allgemeinesmodul

DateienLesen ist das zu startende makro

Option Explicit
Sub DateienLesen()
Call EventsOff
Dim DateiName As String
DateiName = Dir("C:\Temp1\" & "*.xls")
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:="C:\Temp1\" & DateiName
If SheetExists("Adressen") = True Then
Workbooks(DateiName).Worksheets("Adressen").Range("A2:AN" & Workbooks(DateiName).Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row).Copy _
ThisWorkbook.Worksheets(1).Range("A" & ThisWorkbook.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1)
Else
MsgBox ("Die Datei " & DateiName & "hat kein WorkSheet Adressen")
End If
Workbooks(DateiName).Close SaveChanges:=True
End If
DateiName = Dir
Loop
Columns("A:A").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("C8,B:D,G:G,K:M").EntireColumn.Hidden = True
Call EventsOn
End Sub

Public Function SheetExists(strName As String) As Boolean
On Error Resume Next
SheetExists = Not Worksheets(strName) Is Nothing
End Function

Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub

Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Answer 2

hi all ^^

das erste korrigiert :-))

gruss nighty

Sub DateienLesen()
Call EventsOff
Dim DateiName As String
DateiName = Dir("C:\Temp1\" & "*.xls")
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:="C:\Temp1\" & DateiName
If SheetExists("Adressen") = True Then
Workbooks(DateiName).Worksheets("Adressen").Range("A2:AN" & Workbooks(DateiName).Worksheets("Adressen").Range("A" & Rows.Count).End(xlUp).Row).Copy _
ThisWorkbook.Worksheets(1).Range("A" & ThisWorkbook.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1)
Else
MsgBox ("Die Datei " & DateiName & "hat kein WorkSheet Adressen")
End If
Workbooks(DateiName).Close SaveChanges:=True
End If
DateiName = Dir
Loop
Columns("A:A").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("B:D,G:G,K:M").EntireColumn.Hidden = True
Call EventsOn
End Sub

Answer 3

Hej nighty,

besten Dank erstmal für deine Antwort und dein Getüftel. Ich werde es in der nächsten Zeit ausprobieren und Feedback geben. Momentan fehlt mir leider mal wieder die Zeit dafür.

Bis dahin liebs Grüßle
Betsy.dd

Answer 4

hi Betsy ^^

die farbmakierung fehlt aber noch :-)

rosa vielleicht *hihi*

gruss nighty