Gibt es eine Möglichkeit in Excel, (wie in Word) aus EINER Datei anhand eines Kriteriums automatisch mehrere Dateien generieren zu lassen?
Office - Word, Excel und Co. 9.751 Themen, 41.564 Beiträge
S.F.T.I. fiatfahrer „Filialdokumente in Excel?“
Kannst du deine Frage konkreter stellen? Man kann auf jede andere Excelmappe zugreifen.
fiatfahrer S.F.T.I. „Kannst du deine Frage konkreter stellen? Man kann auf jede andere Excelmappe...“
In meiner Liste wiederholt sich in Spalte A ein Wert immer ein paar Zeilen lang, dann wechselt er und der neue Wert wiederholt sich wieder einige Zeilen lang usw. usw. Bei jedem Wechsel dieses Wertes sollen die Zeilen mit dem GLEICHEN Wert in ein separates Dokument gespeichert werden.
Beispiel:
Spalte A Zeile 1-5 : Wert1
Spalte A Zeile 6-8 : Wert2
Zeile 1-5 soll in Mappe1 gespeichert werden
Zeile 6-8 soll in Mappe2 gespeichert werden
usw.
Ich weiß das ist kompliziert, ist auch blöd zum Erklären.
Uli M fiatfahrer „Filialdokumente in Excel?“
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
