Aus mehreren Workbooks Daten importieren
31.08.2016 16:52:07
Simon
da ich noch absoluter VBA-Frischling bin, suche ich hier Hilfe und hoffe ihr könnt mir helfen :) Ich habe es leider bisher nicht hinbekommen, entsprechende Makros im Internet auf meine Bedürfnisse umzuändern.
Situation:
Ich habe einen Ordner ("Leistungsnachweis") in dem ich mehrere Workbooks (.xlsx) habe (aktuell aber nur eines =August 2016) mit gleich aufgebauter Namensstruktur (z.B. Leistungsnachweis_1, Leistungsnachweis_2,...) mit 1-12 für die Monate.
Da ich bei der Benennung aber flexibel bin wäre folgende Benennung meinerseits wünschenswert: Leistungsnachweis_Januar_2016, Leistungsnachweis_November_2015,...
um auch die Jahreszahl mit zu integrieren.
Diese Workbooks haben alle nur ein einziges Worksheet, das von der Datenstruktur immer identisch ist und sich lediglich in der Anzahl der Zeilen unterscheidet.
Die Daten der Sheets sollen alle in eine Datei ("Daten gesamt") im selben Ordner kopiert werden.
Dabei soll von den Sheets jeweils der Bereich "A7:I(letzte benutzte Zeile)" kopiert werden.
In der Zieldatei sollen die Daten dann in den Bereich "A(letzte benutzte Zeile + 1)" (bzw. die ersten importierten Daten ab A3) kopiert werden.
Sahnehäubchen für mich:
Da jeden Monat ja eine weitere Datei hinzu kommt, muss jeden Monat ein neuer Import von (neuen) Daten durchgeführt werden.
1) Ist es möglich dies zu automatisieren (z.B. beim Öffnen der Datei)? Z.B. dass es ausreicht die neue Datei einfach in den Ordner zu verschieben!?
2) Eine automatische Erkennung, welche Dateien(!) (ich sage bewusst nicht Daten, da ich nicht ausschließen möchte, dass es irgendwann zu identischen Werten kommen kann) bereits importiert wurden, sodass diese nicht erneut importiert werden!?
Hier mal meine Anfänger-Krücke von Code (der aber leider nicht funktioniert):
Option Explicit
Sub Daten_importieren()
'Ausschalten
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.DisplayAlerts = False
'Variablen definieren
Dim WZ As Long
Dim Pfad As String
Dim Dateiname As String
Dim Zmax1 As Long
Dim Zmax2 As Long
Dim Source As Workbook
Dim Zmax3 As Long
'Pfad festlegen
Pfad = "H:\Sonstige Daten\Leistungsnachweis"
'Daten importieren
For WZ = 8 To 8
Zmax1 = ThisWorkbook.ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
Dateiname = "Leistungsnachweis_" & WZ & ".xlsx"
Set Source = Workbooks.Open(Pfad & "\" & Dateiname)
Zmax2 = Source.ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
Range("A7:I" & Zmax2).Copy
ThisWorkbook.ActiveSheet.Activate
Range("A" & Zmax1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Source.Close SaveChanges:=False
Next WZ
'Für Zeile J Kosten pro Posten berechnen
Zmax3 = ThisWorkbook.ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
Range("J3").Select
ActiveCell.FormulaR1C1 = "=RC[-3]*RC[-2]"
Range("J3").Select
Selection.Copy
Range("J3:J" & Zmax3).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'Einschalten
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.DisplayAlerts = True
Summenberechnung_Stunden_Kosten
End Sub
Vielen Dank vorab! :)
Grüße Simon