Datei mit Filter splitten
09.08.2016 15:34:51
Leonida
ich habe eine Masterdatei mit Überschriften in Zeile 1 zur Weiterbildungsplanung, die nach Führungskräften (Spalte E) gesplittet werden soll.
Dazu habe ich folgenden Code, um die Datei zu splitten und die einzelnen Dateien unter dem Namen der jeweiligen Führungskraft abzuspeichern:
Sub WB_Planung_splitten()
' WB_Planung_splitten Makro
' Splitten der WB-Planungsliste in einzelne FK-Tools
' Tastenkombination: Strg+w
Dim v, D As Object, wb As Workbook
Application.ScreenUpdating = False
Set D = CreateObject("scripting.dictionary")
With Tabelle1
With .Range("A1:R1200").CurrentRegion
For Each v In .Columns(5).Offset(1).Value
If v "" Then D(v) = 0
Next
For Each v In D.Keys
Set wb = Workbooks.Add(xlWBATWorksheet)
.AutoFilter 5, v
.SpecialCells(xlCellTypeVisible).Copy
wb.Worksheets(1).Cells(1).PasteSpecial Paste:=xlPasteAll
wb.Worksheets(1).Cells(1).PasteSpecial Paste:=xlPasteColumnWidths
wb.Worksheets(1).Cells(1).PasteSpecial Paste:=xlPasteValues
wb.Worksheets(1).Cells(1).PasteSpecial Paste:=xlPasteFormulas
With wb.Sheets(1)
.Name = v
.Cells.Font.Name = "Arial"
.Cells.Font.Size = 8
.Range("K2:O50").Locked = False
.Protect "wb"
End With
wb.SaveAs .Parent.Parent.Path & "\FK Tools" & "\" & v & ".xlsx", _
xlOpenXMLWorkbook
wb.Close False
Next
.AutoFilter
End With
End With
MsgBox "Finished!"
End Sub
Hat jemand einen Tipp, wie ich den Code verändern kann, sodass wirklich nur Dateien gespeichert werden, die auch außer den Überschriften einen Inhalt haben?
Zur Veranschaulichung habe ich eine Beispieldatei angehängt, wie die Masterdatei aussieht.
https://www.herber.de/bbs/user/107497.xlsm