Excel makro stapelverarbeitung

Computer: Software & Programmierung Office Software
#1

Hallo Leute,

ich hoffe ihr könnt mir weiterhelfen.

Ich sitze vor einem Ordner mit 540 e-Mails (text-Dateien) in denen sich Adressen befinden. Alle sind von mir bereits per dos-befehl „ren“ in *.xls umbenannt worden und stehen nun zum import zur verfügung. ich kann sie auch in excel öffnen.

Da die Adressdaten immer im gleichen Bereich (B8:B22) stehen, müsste es doch per makro oder import möglich sein, alle dateien wie folgt zu bearbeiten:

datei öffnen
bereich b8:b22 markieren
kopieren
neue mappe öffnen
einfügen (waagerecht; transponieren)

ziel ist es immer den gleichen bereich aus allen 540 dateien zu kopieren, und in EINE tabelle (waagerecht) einzufügen.

Ich hoffe Ihr konntet mir folgen und warte auf Antworten… Im Voraus schonmal besten Dank für die Mühe!

Beste Grüße

Daniel

#2

Hallo Daniel,

ich hoffe ihr könnt mir weiterhelfen.

das kommt darauf an welche Voraussetzungen bestehen.

Falls die Dateinamen sich nur anhand einer Nummer unterscheiden (von 1 bis 540 wäre ideal), ließe sich das Problem relativ einfach mit einer For-Schleife automatisieren. In dem Fall zählt die Schleife immer eine Zahl hoch und es werden alle Dateien nacheinander abgearbeitet.

Sind die Dateinamen vollkommen unterschiedlich, müsstest du die Dateinamen aus dem Verzeichnis irgendwie in die Excel-Tabelle (schön untereinander) bekommen. Dann könnte man (wieder per For-Schleife) die Dateinamen auslesen und die Dateien ebenfalls nacheinander abarbeiten.

In beiden Fällen sollte die Lösung recht einfach sein.

MfG
Stephan

#3

Hallo Daniel,

Sind die Dateinamen vollkommen unterschiedlich, müsstest du
die Dateinamen aus dem Verzeichnis irgendwie in die
Excel-Tabelle (schön untereinander) bekommen. Dann könnte man
(wieder per For-Schleife) die Dateinamen auslesen und die
Dateien ebenfalls nacheinander abarbeiten.

für diesen Fall habe ich aus lauter Langeweile mal schnell ein Makro programmiert.

Vorgehensweise:

  1. Neue Excel-Datei aufmachen.

  2. Die Dateinamen der 540 Dateien untereinander in die Zellen A1 bis A540 einfügen. (Wie du das hinbekommst ist Dein Problem. Man kann das sicher auch per Makro automatisieren, allerdings habe ich dazu jetzt keine Lust.)

  3. Du legst auf Laufwerk C einen neuen Ordner mit dem Namen „MeinOrdner“ an und kopierst alle 540 Dateien in dieses Verzeichnis.

  4. VBA-Editor in der neuen Excel-Datei öffnen, neues Modul anlegen und dort den ganz unten stehenden Code einfügen.

  5. Setzt den Cursor auf Sub Start() und drücke in der oberen Menüleiste des VBA-Editors die Play-Taste.

  6. 30 Sekunden warten, staunen und sich anschließend freuen.

MfG
Stephan

PS: Hier das Makro.

##############################################
Sub Start()

Application.DisplayAlerts = False

Dim strMaster As String
Dim strPath As String
Dim strFile As String
Dim intA As Integer

strMaster = ActiveWorkbook.Name

'strPath ist das Verzeichnis in dem die einzelnen Dateien liegen
strPath = „C:\DeinOrdner“

Columns(„C:Q“).Select
Selection.ClearContents

For i = 1 To 540

On Error Resume Next

intA = i
strFile = Range(„A“ & i).Value

Call Kopieren(strPath, strFile, intA, strMaster)

Next i

Application.DisplayAlerts = True

End Sub

Function Kopieren(strPath As String, strFile As String, intA As Integer, strMaster As String)

Workbooks.Open Filename:=strPath & strFile
Range(„B8:B22“).Select
Selection.Copy
Windows(strMaster).Activate
Range(„C“ & intA).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Windows(strFile).Activate
Application.CutCopyMode = False

ActiveWindow.Close

End Function
#########################################################

#4

Hallo Stephan,

besten Dank schonmal für Deine schnelle Antwort.

Die Dateien sind mit fortlaufender Nummer benannt (md50000000001.xls).

Wär prima wenn es klappen würde, erspart mir ca. einen halben Tag „copy & paste“… :wink:

MfG

Daniel

#5

datei öffnen
bereich b8:b22 markieren
kopieren
neue mappe öffnen
einfügen (waagerecht; transponieren)

ziel ist es immer den gleichen bereich aus allen 540 dateien
zu kopieren, und in EINE tabelle (waagerecht) einzufügen.

Hallo Daniel,

ggfs, sind die Blattnamen falsch.
Auch die Anzahl Nullen in Format sind nur geschätzt.
ungetestet:

Option Explicit
'
Sub Auslesen()
Dim N As Long, Zei As Long
Const Pfad As String = "C:\Test\md"
Zei = ThisWorkbook.Worksheets("Tabelle1").Range("A" & Rows.Count).End(xlUp).Row
Do
 N = N + 1
 If Dir(Pfad + Format(500000000 + N, "@") & "xls") = "" Then Exit Do
 Workbooks.Open Pfad + Format(500000000 + N, "@" & "xls")
 With ThisWorkbook.Worksheets("Tabelle1")
 Zei = Zei + 1
 ActiveWorkbook.Worksheets("Tabelle1").Range("B8:B22").Copy
 .Cells(Zei, 1).PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False \_
 , Transpose:=True
 End With
 ActiveWorkbook.Close
Loop While 1 'Endlosschleife
End Sub

Gruß
Reinhard