Office - Word, Excel und Co. 9.730 Themen, 41.299 Beiträge

Filialdokumente in Excel?

fiatfahrer / 3 Antworten / Flachansicht Nickles

Gibt es eine Möglichkeit in Excel, (wie in Word) aus EINER Datei anhand eines Kriteriums automatisch mehrere Dateien generieren zu lassen?

bei Antwort benachrichtigen
Uli M fiatfahrer „Filialdokumente in Excel?“
Optionen

Da bastelts du wohl besser ein Makro mit dem Prinzip eines Gruppenwechsels. Es ist nicht unbedingt ein Nachteil, dass Excel diese äußerst buggy Funktionalität von Word nicht bietet. Deiner Aufgabenstellung nach wäre dies dort ohne Makros aber auch nicht zu lösen.

Probiere folgenden Ansatz (Xl-VBA ist nicht eben mein Steckenpferd):
Sub GleicheZeilenAusgliedern()
Const ksPfad = "c:\\Test\\Ergebnis" ' anzupassender Teilname für die Ergebnis-Mappen
Dim oOriWb As Workbook, oNeuWb As Workbook
Dim oOriSheet As Worksheet, oNeuSheet As Worksheet
Dim oOriRg As Range, oNeuRg As Range
Dim vMerk
Dim iMaxCol As Integer
Dim i As Long, iWb As Integer
Dim iStart As Integer, iNext As Integer ' Startzeilen absolut, relativ

Set oOriWb = ActiveWorkbook ' Ausgangs-xls und Blatt also zuvor aktivieren!
Set oOriSheet = oOriWb.ActiveSheet
iStart = 1 ' ggf. ändern
iNext = iStart
With oOriSheet.UsedRange
iMaxCol = .Columns.Count
vMerk = .Cells(iStart, 1)
For i = iStart + 1 To oOriSheet.UsedRange.Rows.Count + 1
If .Cells(i, 1) vMerk Then
iWb = iWb + 1
Set oNeuWb = Workbooks.Add ' ggf. Template
Set oNeuSheet = oNeuWb.Sheets(1) ' immer das 1.Blatt, überflüssige sonstige ggf. löschen
Set oOriRg = .Range(.Cells(iNext, 1), .Cells(i - 1, iMaxCol))
Set oNeuRg = oNeuSheet.Range(oNeuSheet.Cells(1, 1), oNeuSheet.Cells(oOriRg.Rows.Count, iMaxCol))
oNeuRg.Value = oOriRg.Value
oNeuWb.SaveAs ksPfad & iWb & ".xls"
oNeuWb.Close
iNext = i
End If
vMerk = .Cells(i, 1)
Next i
End With
End Sub

bei Antwort benachrichtigen