Jetzt möchte ich, dass das Makro, automatisch jeden Filtereintrag ca. 30 selbst durchgeht, die Auswertung erstellt und die Auswertung in das Verzeichnis schreibt, wo die Ursprungsdatei liegt.
Das Makro welches ich hier im Netz gefunden habe, schreibt auch schön die Datei in das Verzeichnis, aber nur vom derzeitig gesetzten Filter. Ich möchte nicht erst den Filter anklicken und immer das Makro laufen lassen. Außerdem möchte ich gern, dass der Name der Datei, der gesetzte Filter beinhaltet. Der Filter, als der Name steht in Feld B2.
Anbei das Makro:
Sub ExportPivotTable()
Dim ws As Worksheet, newWB As Workbook, p As PivotTable, strNewName As String
'Tabellenblatt setzen auf dem die Pivottabelle liegt
Set ws = Sheets(1)
'Pivottabelle anhand Ihres Namens refernzieren
Set p = ws.PivotTables("PivotTable1")
'Bereich der Pivottabelle kopieren
p.TableRange1.Copy
'Neue Arbeitsmappe erstellen
Set newWB = Workbooks.Add
'Füge die Pivottabelle als reine Daten mit Formatierung in die neue Mappe ein
With newWB.Sheets(1).Range("A3")
.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.PasteSpecial Paste:=xlPasteFormats
.PasteSpecial Paste:=xlPasteColumnWidths
End With
'Kopfzeilen übertragen
ws.Range("1:2").Copy newWB.Sheets(1).Range("A1")
'Name der neuen Arbeitsmappe aus Zelle A2 des Worksheets auslesen (letzte 20 Zeichen der _
Zelle)
strNewName = Right(ws.Range("A2").Value, 20)
'Name des Sheets setzen
newWB.Sheets(1).Name = strNewName
'Neue Arbeitsmappe im selben Verzeichnis wie diese speichern
newWB.SaveAs ThisWorkbook.Path & "\" & strNewName & ".xlsx"
'neue Mappe schließen
newWB.Close True
End Sub
Ich wäre Euch sehr Dankbar, wenn Ihr mir schnell helfen könntet!