Hallo zusammen,
ich als Möchtegern-VBA-Programmierer hänge an einer etwas komplexeren Aufgabe fest & bräuchte etwas Hilfe von etwas erfahreneren anwendern:
Der Code den ich mir zusammengestellt/gebastelt habe soll folgende Aufgabe erfüllen (was soweit klappt):
- eine Auswählbare Anzahl von Dateien in einem Ordner wählen (täglich aktualisierte, hinzukommende Dateien die in einen Sammelordner gespeichert werden)
- diese Dateien untereinander im selben Schema verketten
- die verketteten Dateien in einem Excel-Sheet ausgeben (als "Datenbank" für andere Formeln, die mit z.B. S-Verweis darauf zugreifen sollen)
Das habe ich mit folgendem Code soweit auch hinbekommen:
__________________________________________________________________________________________________________________________
Sub File_Update ()
On Error GoTo errExit
Dim WBQ As Workbook
Dim WBZ As Workbook
Dim varDateien As Variant
Dim lngAnzahl As Long
Dim lngLastQ As Long
Dim numberrows As Integer
Dim countrows As Integer
Dim i As Long
Dim sZeile As Long
Dim eZeile As Long
Set WBZ = ThisWorkbook
WBZ.Worksheets(1).Range("A1:IV65536").ClearContents
varDateien = _
Application.GetOpenFilename("Datei (*.xl*),*.xls", False, "Please mark selected file(s)", False, True)
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
For lngAnzahl = LBound(varDateien) To UBound(varDateien)
Set WBQ = Workbooks.Open(Filename:=varDateien(lngAnzahl))
ThisWorkbook.Activate
lngLastQ = WBQ.Worksheets(1).Range("A1").End(xlDown).Row
With WBZ.Worksheets(1)
sZeile = .Cells(Rows.Count, "C").End(xlUp).Row + 1
WBQ.Worksheets(1).Range("A15:Y" & lngLastQ).Copy
.Range("C" & sZeile).PasteSpecial Paste:=xlPasteValues
eZeile = .Cells(Rows.Count, "C").End(xlUp).Row
.Range("AA" & sZeile).AutoFill Destination:=.Range("AA" & sZeile & ":AA" & eZeile), Type:=xlFillCopy
End With
WBQ.Close
Next lngAnzahl
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.CutCopyMode = False
End With
Range("A1").Select
MsgBox "Es wurden " & UBound(varDateien) & " Dateien zusammengefügt.", 64
Exit Sub
errExit:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
If Err.Number = 13 Then
MsgBox "Es wurde keine Datei ausgewählt"
Else
MsgBox "Es ist ein Fehler aufgetreten!" & vbCr _
& "Fehlernummer: " & Err.Number & vbCr _
& "Fehlerbeschreibung: " & Err.Description
End If
End Sub
_______________________________________________________________________________________________________________________
Was ich allerdings versuche hinzubekommen, aber nicht sicher bin ob/wie ich das einbauen könnte wäre:
eine (in jeder Datei gleich positionierte) Kennummer aus Zelle "D8" kopieren & für jede Tabelle in einer variablen Anzahl von Reihen vor Spalte A einfügen bevor die Dateien zusammengefügt werden.
Hintergrund ist, dass zu jeder Kennummer (Zelle D8) mehrere Messwerte gehören, die aber je nach Tabelle in unterschiedlicher Anzahl vorkommen (z.B. Tabelle A mit Kennummer "1234" hat 2 Messwerte - in Zeilen 11 & 12 der Quelldatei - , während Tabelle B mit Kennummer "5678" 3 Messwerte in Zeilen 11 - 13 hat); diese Messwerte müssen für spätere Verwendung jeweils der Kennummer zugeordner werden (aktuell angedacht z.B. per S-Verweis.
In der "fertigen" Tabelle mit allen Dateien sind die ursprünglichen Zellenwerte um 2 Spalten nach rechts versetzt (ursprüngliche Werte aus A-G eingefügt in C-I), also müsste die Kennummer (Zelle D8 der Ursprungsdatei) in der "neuen" Spalte B vor den Messwerten, die ab Zeile 11 anfangen, mit letzter Zeile variabel (abhängig von Anzahl der Messwerte).
- Meine Lösungsansätze waren z.B. mit Nutzung der Formel "COUNTA" (dadurch die Anzahl der Messwert-Zeilen, die einen Eintrag haben ermitteln) & um diese Anzahl an Zellen nach unten zu kopieren
Allerdings kann ich mir nicht herleiten, wie ich das im Code verbauen könnte & wie/ob es mit dem Setup möglich wäre, alle Quelldateien entsprechend anzupassen & dann in der neuen Form zusammenzufügen (oder während des Kopier-Prozesses die Änderungen vorzunehmen), da in den Quelldateien vor den Messwerten noch keine freie Spalte ist, um die Kennummer davor anzusetzen.
Vielen Dank im Voraus für jegliches Feedback!
|