Hallo!
Ich brauche einmal dringend Hilfe:
Ich habe einige hundert Excel Dateien mit Adressen, welche sich jeweils in immer der selben Zelle befinden. Nun möchte ich diese Adressen in eine neue Excel-Datei zusammenführen ohne SIe einzeln „anwählen“ zu müssen, was sehr aufwendig wäre. Ich könnte mir vorstellen, dass das mit einem Makro möglich sein sollte, kenne mich jedoch nicht allzu gut damit aus.
Kann mir jemand weiterhelfen?
Viele Grüße
pr1ngle
Hi pr1ngle,
handelt es sich um einer Steuerdaten-CD??? 
probiere bitte folgenden Code, es sollten alles benötigten Dateien geöffnet sein. Würde mich über ein Feedback freuen, wenn es geklappt hat:
Alt+F11, Einfügen–Modul, Code reinkopieren, Editor schliessen
Aufrufen mit Extras–Makro–Makro…
Sub tt()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
dat = True
While dat = True
dat = Application.GetOpenFilename(„xls Files (*.xls), *.xls“)
Workbooks.Open dat
zeiQuelle = Sheets(1).Range(„a65536“).End(xlUp).Row
zeiZiel = ThisWorkbook.Sheets(1).Range(„a65536“).End(xlUp).Row
Range(Rows(1), Rows(zeiQuelle)).Copy Destination:=ThisWorkbook.Sheets(1).Cells(zeiZiel, 1)
ActiveWorkbook.Close SaveChanges:=False
Wend
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Gruß
René
Ich habe leider kein Excel mehr installiert und kann es nicht testen, aber wenn Du zumindest ein bißchen was von Macros verstehst, bringt Dich dieses Beispiel auf den richtigen Weg:
http://en.allexperts.com/q/Excel-1059/2008/8/Creatin…
Dieser Code sucht alle Excel-Dateien in einem bestimmten Verzeichnis und schreibt Namen und Größe in das aktuelle Tabellenblatt. Du kannst es einfach so laufen lassen und dann mit ADRESSE() auf die fragliche Zelle verweisen: =ADRESSE(2;3;1;FALSCH;"[Mappe1]Tabelle1").
Mein Google Fu ist heute stark^^
Schau mal, was ich für dich zusammengestellt habe und versuche es einmal hiermit:
Option Explicit
Sub Daten_kopieren()
Dim Pfad As String, Dateiname As String, iRow As Long
Application.ScreenUpdating = False
’ „x:\xxx“ je nach Anforderung anpassen
Pfad = „C:\Eigene Dateien“
Dateiname = Dir(Pfad & „*.xls“)
Do While Dateiname „“
Workbooks.Open Filename:=Pfad & Dateiname
iRow = ThisWorkbook.Sheets(„Tabelle1“).Range(„A65536“).End(xlUp).Offset(1, 0).Row
’ Sheets(#) und Range(„X#“) je nach Anforderung anpassen
Workbooks(Dateiname).Sheets(1).Range(„A1“).Copy
ThisWorkbook.Sheets(„Tabelle1“).Cells(iRow, 1).PasteSpecial
Workbooks(Dateiname).Close
Dateiname = Dir()
Loop
End Sub
Bei dem Makro werden alle Exceldateien in dem Verzeichnis „C:\Eigene Dateien“ geöffnet, die Zellen aus dem ersten Tabellenblatt in Zelle A1 ausgelesen und in das Blatt „Tabelle1“ in der Datei, aus dem das Makro gestartet wurde, in die erste freie Zeile in die Spalte A kopiert.
Ich wäre in jedem Fall dankbar für eine Rückmeldung.
Mein Google Fu ist heute stark^^
Schau mal, was ich für dich zusammengestellt habe und versuche es einmal hiermit:
Option Explicit
Sub Daten_kopieren()
Dim Pfad As String, Dateiname As String, iRow As Long
Application.ScreenUpdating = False
’ „x:\xxx“ je nach Anforderung anpassen
Pfad = „C:\Eigene Dateien“
Dateiname = Dir(Pfad & „*.xls“)
Do While Dateiname „“
Workbooks.Open Filename:=Pfad & Dateiname
iRow = ThisWorkbook.Sheets(„Tabelle1“).Range(„A65536“).End(xlUp).Offset(1, 0).Row
’ Sheets(#) und Range(„X#“) je nach Anforderung anpassen
Workbooks(Dateiname).Sheets(1).Range(„A1“).Copy
ThisWorkbook.Sheets(„Tabelle1“).Cells(iRow, 1).PasteSpecial
Workbooks(Dateiname).Close
Dateiname = Dir()
Loop
End Sub
Bei dem Makro werden alle Exceldateien in dem Verzeichnis „C:\Eigene Dateien“ geöffnet, die Zellen aus dem ersten Tabellenblatt in Zelle A1 ausgelesen und in das Blatt „Tabelle1“ in der Datei, aus dem das Makro gestartet wurde, in die erste freie Zeile in die Spalte A kopiert.
Ich wäre in jedem Fall dankbar für eine Rückmeldung…
Auch hallo,
leider kann ich im kokretem Fall nicht helfen.
Gruß „vomBerge“