ich hoffe jemand kann mir hier helfen.
Ich würde gerne folgenden Code anpassen, so dass nicht neue Tabellenblätter erzeugt werden, sondern neue Arbeitsmappen (die aber danach auch wieder geschlossen werden).
Leider ging es nicht so einfach die Variable wksSheet als Workbook anstatt Worksheet zu definieren.
Der Code erzeugt aus einer Excel-Liste mit Kundennamen für jeden Kunden ein Sheet mit den einzelnen Positionen, speichert dieses ab und schreibt die Summe in eine Übersichtstabelle.
Das Problem ist nur, dass bei langen Kundennamen ein Fehler kommt, weil er das Sheet nicht erzeugen kann. Deshalb möchte ich das über separate Workbooks lösen.
Danke und Grüße
Thommy
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
varArrRange = Sheets("Vorbereitung_Rechnungen").Range("A1", Sheets("Vorbereitung_Rechnungen").Cells.SpecialCells(11)).Value
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
'For lngTMP = 1 To UBound(varArrRange, 1) ' no title
For lngTMP = 2 To UBound(varArrRange, 1) ' with title
If Not .Exists(varArrRange(lngTMP, 1)) Then
ReDim varArrItem(1 To UBound(varArrRange, 2), 1 To 1)
For lngTMP1 = 1 To UBound(varArrRange, 2)
varArrItem(lngTMP1, 1) = varArrRange(lngTMP, lngTMP1)
Next lngTMP1
.Add varArrRange(lngTMP, 1), varArrItem
Else
varArrItem = .Item(varArrRange(lngTMP, 1))
ReDim Preserve varArrItem(1 To UBound(varArrRange, 2), _
1 To UBound(varArrItem, 2) + 1)
For lngTMP1 = 1 To UBound(varArrRange, 2)
varArrItem(lngTMP1, UBound(varArrItem, 2)) = _
varArrRange(lngTMP, lngTMP1)
Next lngTMP1
.Item(varArrRange(lngTMP, 1)) = varArrItem
End If
Next lngTMP
For Each varItem In .keys
If Not IsEmpty(varItem) Then
On Error Resume Next
Set wksSheet = Sheets(varItem)
'On Error GoTo Fin
If wksSheet Is Nothing Then
Set wksSheet = Sheets.Add _
(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
wksSheet.Name = varItem
' next two rows - with title
Sheets("Vorbereitung_Rechnungen").Rows(1).Copy wksSheet.Range("A1")
Application.CutCopyMode = True
End If
varArrItem = .Item(varItem)
' ...End(xlUp)(1) _ .... ' 1 = no title
wksSheet.Range("A" & Rows.Count).End(xlUp)(2) _
.Resize(UBound(varArrItem, 2), UBound(varArrItem, 1)).Value = _
Application.Transpose(varArrItem)
lngTMP2 = wksSheet.Range("A" & Rows.Count).End(xlUp).row
wksSheet.Range("D" & lngTMP2 + 1).Value = "Summe"
wksSheet.Range("E" & lngTMP2 + 1).Value = Application.WorksheetFunction.Sum(Range("G2:G" & lngTMP2))
wksSheet.Columns.AutoFit
With ThisWorkbook.Worksheets("Daten_Rechnungen")
lngTMP3 = .Range("A" & Rows.Count).End(xlUp).row