Excel Sheets speichern unter
10.02.2022 22:23:06
Knipser
ich hänge ein bisschen bei einem Code.
Ich habe ein Excel Workbook mit 2 Sheets. In Sheet1 stehen verschiedene Daten. Das Sheet1 ist ein Template.
Es soll jetzt mit dem Makro, Daten von Sheet1 aus der Spalte A, in Sheet2 übernommen werden und das Template (Sheet2) mit einem neuen Namen abgespeichert werden.
Dies soll als Schleife solange gemacht werden, bis eine leere Zelle in Spalte A erreicht ist.
Das kopieren und erstellen des neuen Excel Sheets, funktioniert schon mal, aber leider wird es nicht gespeichert, sondern nur geöffnet als Book1.xls.
Es wäre super, wenn mir hier mal jemand helfen könnte, da ich hier nicht weiter komme. Hier mein Code dazu:
Sub EinzelnesBlattSpeichern()
Const pfad = "C:\Desktop\"
Dim i As Integer
Dim intLastZ As Integer
Dim LoI As Long
Dim wbAkt As Workbook, wbNeu As Workbook
Dim Name As String
ThisWorkbook.Sheets("Daten").Select
intLastZ = Cells(Rows.Count, 1).End(xlUp).Row
With Worksheets("Daten")
LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, . _
Rows.Count)
On Error GoTo Ende
For LoI = 2 To LoLetzte
Worksheets("Template").Range("B10") = .Cells(LoI, 1)
Worksheets("Template").Select
Set wbAkt = Workbooks("Gesamtdaten.xlsm")
Name = Range("B4").Value & "_" & Range("C4").Value & ".xls"
Set wbNeu = wbAkt.Sheets("Template").Copy
ActiveWorkbook.SaveAs pfad & Name
wbNeu.Close 'Neue Datei wird geschlossen
ThisWorkbook.Sheets("Daten").Select
Next LoI
End With
Ende:
End Sub
Knipser