Ich habe diverse Dateien aus verschiedenen Niederlassungen, die immer gleich aufgebaut sind. Für den Import in eine Access-Datenbank ist der Aufbau allerdings ungeeignet.
Per VBA lasse ich deswegen eine neue "Sammel-Datei" erstellen, die aus jeder Datendatei nur 1 Blatt macht (vorher je Niederlassung/Tag eine Datei).
Der Code funzt soweit auch problemlos. Ich habe das bis jetzt so gelöst, dass alle offenen Dateien geprüft werden, ob es eine Datendatei ist (anhand Name) und wenn ja, wird sie verarbeitet. Dazu müssen dann allerdings alle betroffenen Dateien erst einmal geöffnet werden und anschließend wieder gesschlossen.
Eigentlich wollte ich das lieber so machen, dass alle Datendateien in einem Ordner liegen und der Code sie sich dort sucht, öffnet, bearbeitet und wieder schließt. So weit haben allerdings meine VBA-Kenntnisse nicht gereicht.
Diese Funktionalität würde ich deshalb von den anderen hier mitlesenden Profis erbitten. Vielleicht kann mir jemand zeigen, wie dies gemacht wird. Prinzipiell ist mir die Vorgehensweise schon klar, aber ich scheitere an der richtigen Syntax.
Hier der Code:
Option Explicit
Sub zusammenfassung()
GetMoreSpeed True
Dim wks As Worksheet, zrow As Double, ecol As Double, wkb As Workbook, B_Name As String
Workbooks.Add
ActiveWorkbook.SaveAs filename:="C:\Documents and Settings\...\Desktop\Zusammenfassung.xls", _
FileFormat:=xlNormal
For Each wkb In Workbooks
If InStr(1, wkb.Name, "Auswertung gelöschte") > 0 Then
Workbooks("Zusammenfassung.xls").Worksheets.Add before:=Worksheets(1)
B_Name = Left(wkb.Name, InStr(1, wkb.Name, ".") - 1)
B_Name = Mid(B_Name, InStr(1, B_Name, "LS") + 3, 30)
Workbooks("Zusammenfassung.xls").ActiveSheet.Name = B_Name
For Each wks In wkb.Worksheets
If wks.Name "Auswertung" Then
With ActiveWorkbook.Worksheets(B_Name)
zrow = .Range("A65536").End(xlUp).Row
ecol = wks.Range("IV1").End(xlToLeft).Column
wks.Range("A1:A1").Resize(, ecol).Copy Destination:=.Range("A1")
.Range("A1").Offset(, ecol) = "Datum"
wks.Range("A2:A30").Resize(, ecol).Copy
.Range("A" & zrow + 1).PasteSpecial Paste:=xlPasteValues
.Range("A" & zrow + 1).PasteSpecial Paste:=xlPasteFormats
On Error Resume Next
.Range("A" & zrow + 1 & ":A" & zrow + 29).Offset(, ecol).Value = CDate(wks. _
Name & "2010")
On Error GoTo 0
.Columns("A:A").Resize(, ecol).AutoFit
End With
End If
Next
End If
Next
For Each wks In Worksheets
If InStr(1, wks.Name, "Tabelle") > 0 Then
wks.Delete
End If
Next
GetMoreSpeed False
End Sub
Und zum Testen hier noch eine der Datendateien:https://www.herber.de/bbs/user/70190.xls
Die Datendateien haben original immer den Namen "Auswertung gelöschte LS xyz.xls" (wobei xyz für den Namen der Niederlassung steht).
Falls euch noch andere Fehler oder "Umständlichkeiten" im Code auffallen, bin ich auch gern auf konstruktive Kritik gespannt.
Danke vorab.
Gruß
David