AW: Daten kopieren
21.01.2013 16:35:20
fcs
Hallo Julia,
hier ein Beispiel-Code. Im Prinzip die Idee von Klaus in ausgeschmückter Form umgesetz.
In deiner Buchaltungsdatei legst du ein Weiteres Blatt an, in dem die Abteilungsbezeichnhnungen und die zugehöeigen Dateinamen (inkl. Pfad) gelistet sind.
Das Makro legt eine Kopie der Buchhaltungstabelle an in einer temporären Mappe.
Dann werden die Daten nach den Abteilungen sortiert - verbessert die Kopierleistung nach dem Filtern.
Im nächsten Schritt werden per Autofilter die jeweiligen Abteilungsdaten gefiltert und in die Abteilungsdaten kopiert.
Die Pivottabellen würde ich dann nicht in den Abteilungstabellen mit den Buchchungsdaten erstellen sondern in separaten Exceldateien. Das hat den Vorteil, dass die Abteilungsdatei zu fast beliebigen Zeiten aktualisiert werden können ohne mit den Pivotberichtsauswertungen zu kollidieren.
Wenn die Pivot-Auswertungen in den Dateien mit den Abteilungsbuchungen gemacht werden, dann dürfen diese Dateien während der Makroausführung nicht geöffnet sein.
Gruß
Franz
Sub Export_Data_to_Abteilungen()
Dim wbkBH As Workbook, wksBH As Worksheet
Dim wbkZiel As Workbook, wksZiel As Worksheet
Dim wksAbt As Worksheet, lngZeileAbt As Long
Dim lngZeile As Long
Set wksBH = ActiveWorkbook.Worksheets("Buchhaltung") 'Tabellenblatt mit allen Buchungsdaten
Set wksAbt = ActiveWorkbook.Worksheets("Abteilungen") 'Tabelle mit Abt.-Bezeichnungen _
in Spalte A und Namen der Datei mit dem Buchhaltungsauszug für die Abteilung in Spalte B
With wksAbt
lngZeileAbt = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
'temporäre Kopie des Buchhaltungsblattes erstellen in neuer Mappe erstellen
wksBH.Copy
Set wbkBH = ActiveWorkbook
Set wksBH = wbkBH.Worksheets(1)
With wksBH
'Autofilter deaktivieren, falls gesetzt
If .AutoFilterMode = True Then .AutoFilterMode = False
'In Kopie alle Formeln durch Werte ersetzen
With .UsedRange
.Value = .Value
End With
'letzte Zeile mit Daten in Spalte mit Abteilungsbezeichnung
lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row '1 ggf anpassen
Application.ScreenUpdating = False
With .Range(.Cells(1, 1), .Cells(lngZeile, 7)) 'Startzeile (1) und letzte spalte (7) ggf _
anpassen
'Daten sortieren nach Abteilung
.Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlYes
'Abteilungen abarbeiten in Schleife
For lngZeileAbt = 2 To lngZeileAbt
'Autofilter setzen auf Abteilungsbezeichnung
.AutoFilter Field:=1, Criteria1:=wksAbt.Cells(lngZeileAbt, 1) '1 bei Field ggf. _
anpassen
'Zieldatei für Abteilung öffnen
Set wbkZiel = Application.Workbooks.Open(wksAbt.Cells(lngZeileAbt, 2))
'Zieltabellenblatt setzen
Set wksZiel = wbkZiel.Worksheets(1)
'Altdaten in Zieltabellenblatt löschen
With wksZiel
.UsedRange.ClearContents
End With
'gefilterte Daten kopieren in Zieltabelle
.Copy Destination:=wksZiel.Cells(1, 1)
wbkZiel.Save
wbkZiel.Close
Next
End With
'temporäre Kopie wieder schliessen
wbkBH.Close savechanges:=False
Application.ScreenUpdating = False
End With
End Sub