AW: Zeilen per VBA in neuer Datei speichern
01.08.2020 16:18:08
Werner
Hallo,
naja, viel hat jetzt die Mappe nicht mit deiner Eingangsbeschreibung zu tun.
1. die Daten in deinem Blatt "Tabelle2" löschen
2. Blatt "Tabelle2" umbenennen in "Export"
3. Code in ein allgemeines Modul
4. irgendwohin eine Schaltfläche und der Schaltfläche den Code zuweisen
Datei als .xlsm speichern.
Die einzelnen .xlsx Dateien werden im gleichen Ordner abgespeichert wie die .xlsm Datei.
Option Explicit
Public Sub Exportieren()
Dim loSpalte As Long, i As Long
Application.ScreenUpdating = False
With Worksheets("Daten-Tabelle")
loSpalte = .Cells(1, .Columns.Count).End(xlToLeft).Offset(, 2).Column
.Columns("I").Copy
.Cells(1, loSpalte).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
.Columns(loSpalte).TextToColumns Destination:=.Cells(1, loSpalte), _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, Comma:=False, _
Space:=True, Other:=True, OtherChar:="-", FieldInfo:=Array(Array(1, 1), _
Array(2, 1)), TrailingMinusNumbers:=True
.Columns(loSpalte).RemoveDuplicates Columns:=1, Header:=xlYes
For i = 2 To .Cells(.Rows.Count, loSpalte).End(xlUp).Row
.Range("A1").AutoFilter field:=9, Criteria1:=.Cells(i, loSpalte) & "*"
.AutoFilter.Range.Copy Worksheets("Export").Range("A1")
Worksheets("Export").Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & .Cells(i, loSpalte) & ".xlsx"
ActiveWorkbook.Close False
Worksheets("Export").Cells.ClearContents
Next i
.Range("A1").AutoFilter
.Columns(loSpalte).Resize(, 10).ClearContents
End With
Worksheets("Export").Cells.ClearContents
End Sub
Gruß Werner