|
Hallo,
als VBA-Leihe habe ich mir ein Makro zusammengeschustert, welches die Daten von einer aus SAP exporierten Liste ins richtige "Format" bringt und dann in eine Bestehende Auswertungstabelle importiert.
das alles funktioniert jetzt ziemlich gut, einziges was mir noch fehlt ist den Datenbereich der PivotTabelle zu ändern
Hier der Quellcode, der so weit ist das das Tabellenblatt in der die Pivot Tabelle gespeichert ist aktiviert ist.
was noch passieren sollte, ist das der Datenbereich der Pivottabelle ("A2", "I" & lRowQ) wird
Quellcode is sicherlich nicht perfect
über hilfe würd ich mich freuen :)
Option Explicit
Sub update()
'
' Daten_update Makro
'
' Tastenkombination: Strg+Umschalt+U
Dim wsZiel As Worksheet
Dim wsQuelle As Worksheet
Dim pvt As PivotTable
Dim lRowZ As Integer
Dim lRowQ As Integer
Dim lngLastRow As Long, lngIdx As Long
Dim diaws As Worksheet
Dim pivbereich As Range
'Zielblatt = aktive Datei, aktives Blatt
Set wsZiel = ThisWorkbook.Worksheets("F60_Daten aus COOIS")
Worksheets("F60_Daten aus COOIS").Activate
'alte daten löschen
lRowZ = Cells(Rows.Count, 1).End(xlUp).Row
'MsgBox "Last Row: " & lRowZ --> N/A
Range("A2", "I" & lRowZ + 1000).ClearContents
'Quellblatt = Datei, Blatt 1
Set wsQuelle = Workbooks.Open(Filename:="C:\Users\thstehr\Desktop\F60_update_test\f60-update.xlsx").ActiveSheet
'Quellblatt = aktive Datei, aktives Blatt
Set wsQuelle = ActiveWorkbook.ActiveSheet
'Quellblatt "formatieren"
Rows("1:15").Delete
Range("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("A1:K1").SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
'Überschriften löschen
With wsQuelle
'Identify the last row
lngLastRow = .Range("A" & .Rows.Count).End(xlUp).Row
'Loop from the BOTTOM to the top, deleting rows as you go
For lngIdx = lngLastRow To 1 Step -1
If .Cells(lngIdx, 1) = "Material" Then
.Rows(lngIdx).Delete
End If
Next lngIdx
End With
lRowQ = Cells(Rows.Count, 1).End(xlUp).Row
'MsgBox "Last Row: " & lRowQ --> N/A
Range("J1").Select
ActiveCell.FormulaR1C1 = "=RC[-1]/60"
Range("J1").Select
Selection.AutoFill Destination:=Range("J1", "J" & lRowQ)
Columns("J:J").NumberFormat = "0,00"
Columns("J:J").Copy
Range("I1").PasteSpecial Paste:=xlPasteValues
Columns("I:I").NumberFormat = "#,##0.00"
'Kopieren
wsQuelle.Range("A1", "I" & lRowQ).Copy Destination:=wsZiel.Range("A2", "I" & lRowQ + 1000)
Worksheets("F60_Daten aus COOIS").Activate
Range("A2").Select
'Zielblatt = aktive Datei, aktives Blatt
Set wsZiel = ActiveWorkbook.ActiveSheet
'Quelle schließen
wsQuelle.Parent.Close SaveChanges:=False
Set wsQuelle = Nothing
Set wsZiel = Nothing
'Diagrambereich updaten
Set diaws = ThisWorkbook.Worksheets("F60 Auswertung Tabelle")
Worksheets("F60 Auswertung Tabelle").Activate
End Sub
|