# Makro unterbrechen oder anhalten zwecks "Zwischenspeichern"



## Pr3d4tor (10. Mai 2021)

Guten Morgen zusammen,

ich benötigen mal wieder fachlichen Hilfe oder auch den Schubser in die richtige Richtung 

Aber erstmal ne Info vorab:
Grundsätzlich wird alles über Userform "gesteuert" welche beim öffnen der Mappe direkt geladen wird. Darin befindet sich unteranderem ein DropDown Menü welches durch das Auslesen eines festgelegten Ordners stattfinden, nach der Auswahl wird diese durch ein Button bestätigt.

Dies führt dazu das eine CSV in das aktive Workbook in Tabelle1 importiert wird. Anschließend kann/soll man über verschiedene "Auswahlmöglichkeiten" inkl. eines "Bestätigungsbutton" die Spalten A bis D und eine Anzahl von Zeilen (dafür die Auswahlmöglichkeit) in eine neue Arbeitsmappe kopieren.
Zum Schluß muss man noch an den vorgefertigten Dateiname eine Zahl hinzufügen und durch einen Speicher Button die neue Mappe speichern, schließen und zum "Ursprung" zurück kehren.

DAS ALLES KLAPPT auch soweit *zum Glück* ;-) .... allerdings scheitere ich nun daran die Aufteilung in einzelne Speichern "abfragen" aufzuteilen.
Ich erspare mir aber fürs erste die Datei so ab zu ändern um dann eine Beispieldatei hoch zu laden denn im Moment scheitere ich schon daran dass ich nicht einmal
weiß wonach ich genau Suche soll, mit welchen Befehlen sowas umsetzbar ist oder ob sowas überhaupt machbar ist.

Die Auswahl wird mit folgendem Code umgesetzt:

```
Private Sub CommandButton2_Click()
    Application.DisplayAlerts = False
          Dim NewBook As Workbook
            Set NewBook = Workbooks.Add
            NewBook.SaveAs Environ("Userprofile") & "\Documents\vFlp-Temp\" & "NewBook" & ".xls", True
        Application.DisplayAlerts = True

If OptionButton2.Value = False And OptionButton3.Value = False And OptionButton4.Value = False And OptionButton5.Value = False And OptionButton6.Value = False And OptionButton7.Value = False Then
TextBox1.Value = "Keine Paletten Anzahl ausgewählt"
End If

If OptionButton2.Value = True Then
    Workbooks("vFlp").Worksheets("Tabelle1").Range("A1:D15").Copy Destination:=Workbooks("NewBook").Worksheets("Tabelle1").Range("A1")

Workbooks("vFlp").Activate
End If
```
Das funktioniert auch ohne Probleme.
Was ich allerdings als Final brauche ist folgendes:
Egal welche Auswahl getroffen wird, es sollen als erstes immer "A1 : D4"in die neue Mappe kopiert werden. Anschließend der durch die Auswahl gewählte Bereich und abschließen die restlichen Zeilen danach bis zur letzten gefühlten Zelle. 

Beispielcode dafür:


```
Private Sub CommandButton2_Click()
    Application.DisplayAlerts = False
          Dim NewBook As Workbook
            Set NewBook = Workbooks.Add
            NewBook.SaveAs Environ("Userprofile") & "\Documents\vFlp-Temp\" & "NewBook" & ".xls", True
        Application.DisplayAlerts = True

If OptionButton2.Value = False And OptionButton3.Value = False And OptionButton4.Value = False And OptionButton5.Value = False And OptionButton6.Value = False And OptionButton7.Value = False Then
TextBox1.Value = "Keine Paletten Anzahl ausgewählt"
End If

If OptionButton2.Value = True Then       
Dim loAnzahl As Long
    loAnzahl = Worksheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Row
        Workbooks("vFlp").Worksheets("Tabelle1").Range("A1:D4").Copy Destination:=Workbooks("NewBook").Worksheets("Tabelle1").Range("A1")
        Workbooks("vFlp").Worksheets("Tabelle1").Range("A5:D20").Copy Destination:=Workbooks("NewBook").Worksheets("Tabelle1").Range("A1")
        'hier müsste jetzt das erstmal unterbrochen werden und das Eintrag der Flp Nr.01 inkl dem Speichern stattfinden'
        
        Workbooks("vFlp").Worksheets("Tabelle1").Range("A20:D44").Copy Destination:=Workbooks("NewBook").Worksheets("Tabelle1").Range("A1")
        'hier müsste wieder unterbrochen werden und der Eintrag der Flp Nr.02 inkl dem Speichern stattfinden'
        
        Workbooks("vFlp").Worksheets("Tabelle1").Range("A44:D" & loAnzahl).Copy Destination:=Workbooks("NewBook").Worksheets("Tabelle1").Range("A16")
        'hier wird jetzt der Rest kopiert, benötigt eigentliche auch keine Nummer oder so... inkl dem Speichern stattfinden'

Workbooks("vFlp").Activate
End If
```

Gespeichert wird hiermit:

```
Private Sub CommandButton3_Click()
If txtFlp = "XX" Then 'Or txtFlp = 0 Then
MsgBox "Es wurde keine Nummer für die FLP angegeben"
    Exit Sub
        Else
            Call runExport
        MsgBox "CSV-Flp Datei wurde erfolgreich erstellt"
End If
End Sub
```

Wie bekomme ich es nun das der Ablauf unterbrochen wird, man die Flp Nr. eingibt, abspeichert und das ganze ab da weiterläuft?
Oder geht sowas händisch gar nicht? Bleibt dann aber wie ich das ganze Unterbreche und automatisch mit fortlaufender Nummer speichere.

Bin schon soweit gekommen aber jetzt kurz vorm Ende fehlte mir jede Idee und auch jede Wortwahl nach der ich Suche könnte um das ganze umzusetzen :-(

Hat einer von Euch vielleicht den richtigen Anstoß?#
Wie gesagt, der gesamte Code funktioniert ohne Probleme, ich scheitere jetzt nur an der geteilten Speicherung während des Ablaufs.



Danke vorab an alle..

Vg


----------



## Yaslaw (10. Mai 2021)

Ich bin beim Verstehen des 1ten Code-Teils bereits gescheitert.
OptionButton2, OptionButton3 etc. Wie heissen die? Was wählt da der User aus?
Du prüfst auf Option2-7 wertest aber nachher nur die Option2 aus.

Zu der Frage dort. Kopiere einfach, unabhängig von den Optionen den Range A14 und werte die Optionen erst danach aus.

Tipp: Im Form die Buttons und Felder so benennen, dass man im Code erkennt was sie sollen

Zur Nummerabfage. Einfach eine InputBox() nehmen und der ser wird aufgefordert etwas einzugeben.
Das Resultat prüfen ob es numerisch ist und ansonsten nachhacken.


```
Dim varFlpNr
    Dim dblFlpNr As Long
    Dim prePrompt As String
    Do
        varFlpNr = InputBox(prePrompt & "Enter the Flp Nr (numeric)")
        If IsNumeric(varFlpNr) Then
            dblFlpNr = CLng(varFlpNr)
        Else
            prePrompt = "'" & varFlpNr & "' is not numeric. " & vbCrLf & vbCrLf
        End If
    Loop While dblFlpNr = 0
    MsgBox dblFlpNr
```


----------



## Zvoni (10. Mai 2021)

Ich seh noch ein anderes Problem.
1. Code - Zeile 5 (das NewBook.SaveAs)
Im 1. Parameter gibst du den Dateinamen an (korrekt inkl. Pfad), im zweiten ein "True" --> einen Boolean?
Workbook.SaveAs-Methode (Excel)
Der zweite Parameter ist das DateiFormat!!!
nur weil du ".xls" als Erweiterung hast, heisst es noch lange nicht, dass es im "alten" Excel-Format auch gespeichert wird


----------



## Pr3d4tor (10. Mai 2021)

Yaslaw hat gesagt.:


> Ich bin beim Verstehen des 1ten Code-Teils bereits gescheitert.
> OptionButton2, OptionButton3 etc. Wie heissen die? Was wählt da der User aus?
> Du prüfst auf Option2-7 wertest aber nachher nur die Option2 aus.


Ich finde die Bennenung der Buttons nicht wirklich relevant für die Lösung, habs aber mal geändert.
Und ich werte schon alle OptionButton aus, jedoch wiederholen die sich im Grunde daher habe ich nur ein Beispiel eingefügt.


Yaslaw hat gesagt.:


> Zur Nummerabfage. Einfach eine InputBox() nehmen und der ser wird aufgefordert etwas einzugeben.
> Das Resultat prüfen ob es numerisch ist und ansonsten nachhacken.
> 
> 
> ...


Bleibt für mich aber noch die Frage offen wie ich dies so einfüge dass das Erstellen der einzelnen Mappe klappt?


Zvoni hat gesagt.:


> Ich seh noch ein anderes Problem.
> 1. Code - Zeile 5 (das NewBook.SaveAs)
> Im 1. Parameter gibst du den Dateinamen an (korrekt inkl. Pfad), im zweiten ein "True" --> einen Boolean?
> Workbook.SaveAs-Methode (Excel)
> ...


Das "True" muss mir beim kopieren aus einer anderen Mappe mitgerutscht sein, habs direkt mal rausgenommen und das Format hinzugefügt. Hoffe "51" ist da die beste Wahl gewesen?

Hier mal die angepasste Version:

```
Private Sub csvspeichern_Click()
If txtFlp = "XX" Then 'Or txtFlp = 0 Then
MsgBox "Es wurde keine Nummer für die FLP angegeben"
    Exit Sub
        Else
            Call runExport
        MsgBox "CSV-Flp Datei wurde erfolgreich erstellt"
End If
End Sub

Private Sub zellenCopyPaste_Click()
    Application.DisplayAlerts = False
          Dim NewBook As Workbook
            Set NewBook = Workbooks.Add
            NewBook.SaveAs Environ("Userprofile") & "\Documents\vFlp-Temp\" & "NewBook" & ".xlsx", FileFormat:=51
        Application.DisplayAlerts = True

If eineFlp.Value = False And zweiFlp.Value = False And dreiFlp.Value = False And fuenfFlp.Value = False And siebenFlp.Value = False And neunFlp.Value = False Then
TextBox1.Value = "Keine Paletten Anzahl ausgewählt"
End If

If eineFlp.Value = True Then
Dim loAnzahl As Long
    loAnzahl = Worksheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Row
        Workbooks("vFlp").Worksheets("Tabelle1").Range("A1:D4").Copy Destination:=Workbooks("NewBook").Worksheets("Tabelle1").Range("A1")
        Workbooks("vFlp").Worksheets("Tabelle1").Range("A5:D15").Copy Destination:=Workbooks("NewBook").Worksheets("Tabelle1").Range("A5")
        'hier Speichern Flp Nr.1'
        Workbooks("vFlp").Worksheets("Tabelle1").Range("A16:D" & loAnzahl).Copy Destination:=Workbooks("NewBook").Worksheets("Tabelle1").Range("A16")
        'hier speichern Flp Rest'
MsgBox "Vorgang war erfolgreich"
Workbooks("vFlp").Activate
End If

If zweiFlp.Value = True Then
Dim loAnzahl As Long
    loAnzahl = Worksheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Row
        Workbooks("vFlp").Worksheets("Tabelle1").Range("A1:D4").Copy Destination:=Workbooks("NewBook").Worksheets("Tabelle1").Range("A1")
        Workbooks("vFlp").Worksheets("Tabelle1").Range("A5:D15").Copy Destination:=Workbooks("NewBook").Worksheets("Tabelle1").Range("A5")
        'hier speichern Flp Nr.1'
        Workbooks("vFlp").Worksheets("Tabelle1").Range("A16:D44").Copy Destination:=Workbooks("NewBook").Worksheets("Tabelle1").Range("A16")
        'hier speichern Flp Nr.2'
        Workbooks("vFlp").Worksheets("Tabelle1").Range("A45:D" & loAnzahl).Copy Destination:=Workbooks("NewBook").Worksheets("Tabelle1").Range("A45")
        'hier speichern Flp Rest'
MsgBox "Vorgang war erfolgreich"
Workbooks("vFlp").Activate
End If
'usw'
End Sub
```

Hier habe mir jetzt schon Überlegt ob man nicht vielleicht auch einfach hingehen kann und anstatt der Abfrage nach der Nr. einfach eine zweite neue Mappe erstellen kann?

Also den Teil mit dem Erstellen der Mappe, wenn möglich, "zusammen" packt und dann beim
'hier speichern Flp Nr.1" das Newbook Speichert und ein Newbook1 erstellt usw.
Quasi sowas hier mal als Beispielt im Bezug auf den Code:

```
Workbooks("vFlp").Worksheets("Tabelle1").Range("A1:D4").Copy Destination:=Workbooks("NewBook").Worksheets("Tabelle1").Range("A1")
        Workbooks("vFlp").Worksheets("Tabelle1").Range("A5:D15").Copy Destination:=Workbooks("NewBook").Worksheets("Tabelle1").Range("A5")
        'NewBook speichern und NewBook1 erstellen'
        Workbooks("vFlp").Worksheets("Tabelle1").Range("A16:D44").Copy Destination:=Workbooks("NewBook").Worksheets("Tabelle1").Range("A16")
        'NewBook1 speichern und NewBook2 erstellen'
        Workbooks("vFlp").Worksheets("Tabelle1").Range("A45:D" & loAnzahl).Copy Destination:=Workbooks("NewBook").Worksheets("Tabelle1").Range("A45")
        'NewBook2 speichern und NewBook3 erstellen'
```

Oder Alternativ NewBook löschen, wird ja eh nur Temporär gespeichert ums bennen zu können.
Von mir aus auch gleichzeitg alle Newbooks erstellen wenn das mit ner Abfrage zwischem den Zeilen kopieren geht.



VG


----------



## Yaslaw (10. Mai 2021)

Erst mal - für sich mag es egal sein wie die Buttons heissen - für jeden der keine AHnung hat was du programmieren willst ist es eine grosse Hilfe.

Und achte auf deine Formatierung. Tabs am Anfang des Codes nach Zufallsprinzip macht den Code unlesbar.
Hier mal für alle anderen die helfen wollen, den Originalcode in lesbar, ergänzt um Funktionskommentar

```
'/**
' * Event beim Klicken des Buttons csvspeichern_Click
' * prüft auf die unbekannte Variabe txtFlp (ev diejenige die abgefragt werden soll?) und führt ggf ein unbekannter runExport() auf
' */
Private Sub csvspeichern_Click()
    If txtFlp = "XX" Then 'Or txtFlp = 0 Then
        MsgBox "Es wurde keine Nummer für die FLP angegeben"
        Exit Sub
    Else
        Call runExport
        MsgBox "CSV-Flp Datei wurde erfolgreich erstellt"
    End If
End Sub

'/**
' * Event beim Klicken des Buttons zellenCopyPaste_Click
' * <Hier Text einfügen was das Ding machen soll>
' */
Private Sub zellenCopyPaste_Click()
    Application.DisplayAlerts = False
    Dim NewBook As Workbook
    Set NewBook = Workbooks.Add
    NewBook.SaveAs Environ("Userprofile") & "\Documents\vFlp-Temp\" & "NewBook" & ".xlsx", FileFormat:=51
    Application.DisplayAlerts = True


    If eineFlp.Value = False _
            And zweiFlp.Value = False _
            And dreiFlp.Value = False _
            And fuenfFlp.Value = False _
            And siebenFlp.Value = False _
            And neunFlp.Value = False _
    Then
        TextBox1.Value = "Keine Paletten Anzahl ausgewählt"
    End If

    If eineFlp.Value = True Then
        Dim loAnzahl As Long
        loAnzahl = Worksheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Row
        Workbooks("vFlp").Worksheets("Tabelle1").Range("A1:D4").Copy Destination:=Workbooks("NewBook").Worksheets("Tabelle1").Range("A1")
        Workbooks("vFlp").Worksheets("Tabelle1").Range("A5:D15").Copy Destination:=Workbooks("NewBook").Worksheets("Tabelle1").Range("A5")
        'hier Speichern Flp Nr.1'
        Workbooks("vFlp").Worksheets("Tabelle1").Range("A16:D" & loAnzahl).Copy Destination:=Workbooks("NewBook").Worksheets("Tabelle1").Range("A16")
        'hier speichern Flp Rest'
        MsgBox "Vorgang war erfolgreich"
        Workbooks("vFlp").Activate
    End If

    If zweiFlp.Value = True Then
        Dim loAnzahl As Long
        loAnzahl = Worksheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Row
        Workbooks("vFlp").Worksheets("Tabelle1").Range("A1:D4").Copy Destination:=Workbooks("NewBook").Worksheets("Tabelle1").Range("A1")
        Workbooks("vFlp").Worksheets("Tabelle1").Range("A5:D15").Copy Destination:=Workbooks("NewBook").Worksheets("Tabelle1").Range("A5")
        'hier speichern Flp Nr.1'
        Workbooks("vFlp").Worksheets("Tabelle1").Range("A16:D44").Copy Destination:=Workbooks("NewBook").Worksheets("Tabelle1").Range("A16")
        'hier speichern Flp Nr.2'
        Workbooks("vFlp").Worksheets("Tabelle1").Range("A45:D" & loAnzahl).Copy Destination:=Workbooks("NewBook").Worksheets("Tabelle1").Range("A45")
        'hier speichern Flp Rest'
        MsgBox "Vorgang war erfolgreich"
        Workbooks("vFlp").Activate
    End If
    'usw'
End Sub
```


Was war die Frage? Ich weiss auch nicht wo die die Nummerabfrage einbauen solltest, da ich nicht wiess was du damit machen willst. Was soll mit der abgefragten Nummer passieren?

Noch ein Tipp, COde der sich wiederholt sollte man in eine Funktion auslagern. Oder willst du den if-Block wirklich 7 mal programmieren?


----------



## Pr3d4tor (11. Mai 2021)

Yaslaw hat gesagt.:


> Erst mal - für sich mag es egal sein wie die Buttons heissen - für jeden der keine AHnung hat was du programmieren willst ist es eine grosse Hilfe.
> 
> Und achte auf deine Formatierung. Tabs am Anfang des Codes nach Zufallsprinzip macht den Code unlesbar.


Tachen,

vielen Dank erst einmal für deine Tipps, werde mir sie in Zukunft zu Herzen nehmen und auch den Ablauf über Kommentare verständlicher zu gestalten.


Yaslaw hat gesagt.:


> Was war die Frage? Ich weiss auch nicht wo die die Nummerabfrage einbauen solltest, da ich nicht wiess was du damit machen willst. Was soll mit der abgefragten Nummer passieren?
> 
> Noch ein Tipp, COde der sich wiederholt sollte man in eine Funktion auslagern. Oder willst du den if-Block wirklich 7 mal programmieren?


Was den Kompletten nutzen bzw. den Ablauf abgeht würde das den Rahmen aufgrund der Komplexität angeht sprengen und nur mehr Verwirrung stiften. Grundlegen wird die Ursprüngliche CSV Datei zur Datenerfassung in ein anderes Programm importiert und entsprechend den Vorgaben dort weiter „verarbeitet“. Wie sich mit der Zeit nun aber gezeigt hat ist bei manchen Dateien notwendig diese „Aufzuteilen“ und dafür werden immer die ersten vier Zeilen der Ursprungsdatei benötigt sowie die Daten ab Zeile fünf. Diese Daten dürfen aber nur einmal Vorkommen daher möchte ich diese aus der original Datei in eine separate CSV kopieren.

Aus diesem Grund habe oder versuche ich gerade ein Makro zu erstellen über das man die originale CSV Datei in Excel importiert, Excel die Zeilen 5 bis zur letzten gefüllten Zeile zählt, berechnet wie viele Flp (Flachpaletten) theoretisch erstellt werden können und dies in einer Textbox dann wiedergibt, was bisher auch fehlerfrei Funktioniert.

*Bedeutet für mein weiteres Vorhaben und den Grund der Nummerierung folgendes.*
Es wird die original Datei eingelesen und der User kann zwischen 0, 1, 2, 3, 5, 7, und 9 Flp auswählen (OptionButton 0 bis 7). Ob ich dafür die IF-Anweisung nun siebenmal wiederholen muss oder ob man dies auch in eine Funktion packen kann ist für mich zum einen erstmal Nebensache und auch außerhalb meiner bisherigen VBA Kenntnisse ;-)

*Auf jeden Fall sollte es mit der Nummerierung wie folgt ablaufen.*

*- 1 Flp ausgewählt bedeutet:*
Es werden die Zeilen A1-DX (momentan Denke ich an irgendwas zwischen Zeile D15 und D20) in eine neue Mappe kopiert. Dann muss diese neue Mappe gespeichert werden und soll die Nr.1 bekommen. Nachdem speichern müssen dann die Zeilen A1-D4 in eine neue Mappe kopiert werden sowie die Zeilen in dem Beispiel dann A16 oder A21 bis zur letzten gefüllten Zeile in diese Mappe kopiert werden. Diese Mappe würde dann entweder Nr.2 sein oder auch „Rest“.

*- 2 Flp ausgewählt bedeutet:*
Der gleiche Ablauf wie bei 1Flp nur das nach dem Speichern von Nr.1 die Zeilen A16 oder A21 bis Zeile D30 oder D35 in diese Mappe kopiert werden und mit Nr.2 gespeichert.
Danach werden dann noch A31 oder A36 bis zur letzten gefüllten Zeile kopiert und als Nr.3 oder „Rest“ gespeichert.

*Also immer:*
1Flp Zeilen A1 bis D15 als Nr.1, A16 bis zur letzten gefüllten Zeile als „Rest“
2Flp Zeilen A1 bis D15 als Nr.1, A16 bis D30 als Nr.2, A31 bis zur letzten gefüllten Zeile als „Rest“
usw.  

Hoffe es jetzt etwas verständlicher geworden was ich im Grund benötige ;-)
Die Abfrage der Nummer dient nur dem Abspeichern und Bennenung der jeweiligen Datei und soll beim kopieren der Zeilen in die neue Mappe als "Unterbrechung" dienen.

Hab mal ein Foto von der UserForm angehangen. Wenn jetzt noch was unklar ist versuche ich mal am Wochenende eine Beispiel Datei zur Verfügung zu stellen.


----------



## Yaslaw (11. Mai 2021)

Merci, ich glaub ich versteh jetzt die Zusammenhänge. EIne Frage noch.

Wenn 7 Flp möglich sind, und der User wählt 5.
Was soll dann gemacht werden?
a) Die Fld Grösse verändert, so dass alle Daten auf 5 Flp verteilt werden
b) die Flp 6 und 7 einfach weggelassen wird
c) was anderes


----------



## Pr3d4tor (12. Mai 2021)

Im Grunde soll alles was an "Rest" noch vorhanden ist, abschließend in eine letzte Datei kopiert werden.

In deinem Beispiel: wenn 7 möglich sind und er nur 5 auswählt, wird der Rest(6 und7) bis zur letzten gefüllten Zeile kopiert und entweder als "FLP Rest" oder eben als "FLP 6" gespeichert.

Und was die Flp "größe" an sich angeht bin ich mir noch nicht so sicher.
Ich denke aber das es Pro FLP ... 15 bis 20 Zeilen werden sollen. Je nachdem wie die Programmierung bzw. das Makro am Ende aussieht/arbeitet. Vielleicht variiere ich das Ganze auch noch, wenn möglich.


----------



## Yaslaw (12. Mai 2021)

Ich habe Probleme, dein Code dierkt zu verbessern. Das Thema selber ist aber Interessant. Ich habe mir darum mal die Freiheit genommen, selber einen Code zu schreiben um dieses Problem anzugehen.

Mein Ansatz:

Letzter Lauf löschen
Berechnen der Anzahl Flp
Mit einem Loop durchgehen und diese erstellen
Weitere Erklärungen sind direkt im Code. In der Sub zellenCopyPaste_Click() muss natürlich noch die Form-Eingabe übernommen werden.

Deine Radiobuttons sind überflüssig.


```
Option Explicit

Const C_HEAD_ROWS& = 4                  'Anzahl Kopfzeilen die in jedes Flp kopiert werden
Const C_DATA_FIRST_COL& = 1             'Spalte A
Const C_DATA_LAST_COL& = 4              'Spalte D
Const C_DATA_SHEET_NAME$ = "vFlp"       'Name der Tabelle mit den Quelldaten
Const C_FLP_SIZE_DEFAULT& = 15          'Standard der Anzahl Datenzeilen pro Flp

'/**
' * Event beim Klicken auf den Button zellenCopyPaste
' * Liest die Eingaben aus dem Formular aus und startet die Aufteilung in die versch. Flp
' */
Private Sub zellenCopyPaste_Click()
    createFlps <TODO: Flipe-Nr aus dem Fomular>
End Sub

'/**
' * Teilt die Quelle in die einzelnen Flps auf
' * @param  Long    Anzahl Flp. Sollte dieser kleiner als 1 sein oder grösser als der berechnete Wert, wird er ignoriert. Standard = 0
' * @param  Long    Anzahl Zeilen pro Fld. Standard = C_FLP_SIZE_DEFAULT
' */
Public Sub createFlps(Optional ByVal iSelectedFlipCount& = -1, Optional ByVal iFlpSize& = C_FLP_SIZE_DEFAULT)
    'Vom letzten Lauf aufräumen
    cleanFlps
 
    'Quelltabelle auslesen
    Dim wsSrc As Worksheet: Set wsSrc = ThisWorkbook.Worksheets(C_DATA_SHEET_NAME)
    'Letzte Zeile ermitteln
    Dim lastRowNr&:         lastRowNr = xlsGetLastRow(wsSrc)
    'Anzahl Datenzeilen (ohne Header) berechnen
    Dim dataRows&:          dataRows = lastRowNr - C_HEAD_ROWS
    'Anzahl Flp berechnen
    Dim flpCount&:          flpCount = dataRows \ iFlpSize + 1
    'Der Count-Parameter  muss grösser als 0 sein und kleiner als der Berechnete. Ansonsten wird der Berechnete beibehalten.
    If 0 < iSelectedFlipCount And iSelectedFlipCount < flpCount Then flpCount = iSelectedFlipCount
    'Zeilenanzahl des letzten Flp berechnen
    Dim flpRestSize&:       flpRestSize = dataRows - ((flpCount - 1) * iFlpSize)
 
    'Die einzelnen Flp erstellen
    Dim flpNr&
    For flpNr = 1 To flpCount
        'Neue Tabelle erstellen
        Dim wsFlp As Worksheet:     Set wsFlp = ThisWorkbook.Worksheets.Add
        wsFlp.Name = "FLP_" & flpNr
    
        'Header kopieren
        wsSrc.Range( _
            wsSrc.Cells(1, C_DATA_FIRST_COL), _
            wsSrc.Cells(C_HEAD_ROWS, C_DATA_LAST_COL) _
        ).Copy wsFlp.Range("A1")
    
        'Datenzeilen der Quelle für diesen Flp berechnen
        'Erste Datenzeile
        Dim flpStartRow&:   flpStartRow = (flpNr - 1) * iFlpSize + C_HEAD_ROWS + 1
        'Anzahl Datenzeilen
        Dim flpSize&:       flpSize = IIf(flpNr < flpCount, iFlpSize, flpRestSize)
        'Letzte Datenzeile
        Dim flpEndRow&:     flpEndRow = flpStartRow + flpSize - 1
    
        'Die Datenzeilen kopieren
        wsSrc.Range( _
            wsSrc.Cells(flpStartRow, C_DATA_FIRST_COL), _
            wsSrc.Cells(flpEndRow, C_DATA_LAST_COL) _
        ).Copy wsFlp.Cells(C_HEAD_ROWS + 1, 1)
    Next
 
End Sub

'/**
' * Entfern die Alle Flp-Tabellen
' */
Public Sub cleanFlps()
    Application.DisplayAlerts = False
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name Like "FLP_*" Then ws.Delete
    Next
    Application.DisplayAlerts = True
End Sub


'/**
' * ermitteln der letzten gefüllten Zeile eines Worksheets
' * Die Funktion Sheet.Cells.SpecialCells(xlCellTypeLastCell) liefert auch instanzierte Zeilen ohne Inhalt
' * https://wiki.yaslaw.info/doku.php/vba/excel/functions/getlastrowcol
' * @param  Worksheet               Eine Referenz auf das Worksheet
' * @return Long                    Zeilenindex der letzten Zeile mit Inhalt
' */
Public Function xlsGetLastRow(ByRef Sheet As Excel.Worksheet) As Long
    Dim r As Variant
 
    xlsGetLastRow = Sheet.Cells.SpecialCells(xlCellTypeLastCell).row
    For r = xlsGetLastRow To 1 Step -1
        If Sheet.Application.WorksheetFunction.CountA(Sheet.rows(r)) = 0 Then
            xlsGetLastRow = r - 1
        Else
            Exit For
        End If
    Next r
End Function
```

Nachtrag:
Ich habe das Program von dem Click-Event getrennt. So kann man das ganze bequem aus dem Direktfenster von VBA testen

```
createFlps 5
```


----------



## Pr3d4tor (12. Mai 2021)

Yaslaw hat gesagt.:


> Ich habe Probleme, dein Code dierkt zu verbessern. Das Thema selber ist aber Interessant. Ich habe mir darum mal die Freiheit genommen, selber einen Code zu schreiben um dieses Problem anzugehen.


Hehe okay,

dafür an dieser Stelle erst einmal vielen Dank für deine Bemühungen.
Eventuell, wenn ich es Zeitlich hinbekomme und unabhängig davon ob mich dein Code weiterbringt oder nicht, werde ich am WE mal schauen ob ich meine Datei so umbasteln kann das ich sie dir dann per PN zu kommen lasse.



Yaslaw hat gesagt.:


> Mein Ansatz:
> 
> Letzter Lauf löschen
> Berechnen der Anzahl Flp
> ...


Oookay,

gut zu Wissen das es anscheinend auch ohne geht. Aufgrund deiner ganzen ausführlichen Erklärungen sollte eine Umsetzung kein Problem sein.

Nochmals vielen Dank dafür und sobald ich die Zeit und Ruhe habe werde ich mir das ganze mal anschauen und Testen. Rückmeldung dazu gibts natürlich dann auch von mir...


----------



## Pr3d4tor (13. Mai 2021)

Moin,

gerade mal den ersten spontanen Versuch gestartet und ich muss sagen das hat doch mal was...
Ein Missverständnis ist mir allerdings direkt aufgefallen ;-) 

Angenommen ich gebe für die Anzahl der Flp "5" ein, dann sollen fünf Flp´s mit jeweils 15 Zeilen erstellt werden UND ZUSÄTZLICH eine 6te Flp in der landen dann die übrig geblieben Zeilen bis zur letzten.
Also:

3Flp + RestFlp
4Flp + RestFlp
5Flp + RestFlp usw.

später mal schauen ob ich das hinbekomme.

Generell aber nochmal an dieser Stelle ein riesen Dankeschön für deine Bemühungen @Yaslaw , dass das vom Code her dann doch mit so "wenig" VBA im Vergleich zu meinem machbar ist, haut mich um.

Eine Frage habe ich aber doch noch, da ich es für einen tollen Zusatz halte und gerne wüsste was davon geht und was die bessere Wahl wäre.Und zwar wäre es ja cool wenn nach dem Erstellen der Flp Blätter diese auch direkt in einem vorgegeben Ordner gespeichert werden natürlich inkl. Vorgegeben Namen.

Oder wäre es in dem Fall sinnvoller deinen Code so umzubauen das anstatt der Blätter dann doch direkt Flp Arbeitsmappen erstellt werden, gespeichert unter vorgegebenen Namen und anschließend auch geschlossen werden? 

Später mal näher mit beschäftigen denke ich.
Den Code für das "Zusammenbasteln" vom Dateinamen habe ich ja schon, muss dann nur mal schauen ob und wie ich das in Kombination mit dem Speichern von nem Tabellenblatt hinbekomme.


Nochmals Vieeelen Dank
und einen schönen Feiertag.


Vg


----------



## Yaslaw (13. Mai 2021)

Was soll es machen, wenn der User eine zu hohe Zahl eingibt.
Annahme, es hat "Nur" 10 Datenzeilen und er gibt eine 1 ein. Soll das FLP_2 leer sein?


----------



## Yaslaw (13. Mai 2021)

Achja, eine einfache Funktion zum exportieren. Kann man gemütlich aus der Schleife pro FLP aufrufen

```
'/**
' * Exportiert eine einzelne Exceltabelle
' * @param  Worksheet   Die zu exportierende Tabelle
' * @param  Long        Die FLP-Nummer
' */
Public Sub exportWs(ByRef ioWs As Worksheet, ByVal iFlpNr&)
    Dim filePath$:                  filePath = "C:\_TMP\FLP_" & iFlpNr & ".xlsx" 'TODO: Pfad anpassen
   
    'Prüfen ob bereits vorhanden, ggf löschen
    If Dir(filePath) <> "" Then
        If MsgBox("File " & filePath & " already exists." & vbCrLf & "overwrite?", vbYesNo + vbCritical) = vbNo Then Exit Sub
        Kill filePath
    End If
   
    Dim wbTarget As Workbook:       Set wbTarget = Workbooks.Add        'Neues Workbook
    ioWs.Copy Before:=wbTarget.Sheets(1)
    wbTarget.SaveAs filePath
    wbTarget.Close
End Sub
```


----------



## Pr3d4tor (13. Mai 2021)

Yaslaw hat gesagt.:


> Was soll es machen, wenn der User eine zu hohe Zahl eingibt.
> Annahme, es hat "Nur" 10 Datenzeilen und er gibt eine 1 ein. Soll das FLP_2 leer sein?


In dem Fall soll gar nichts passieren bzw. würde ich, denke ich, ne MsgBox "Anzahl der gewünschten Flp´s zu hoch" oder so einfügen....

Es gibt aber, wenn du dir das Bild nochmal anschaust, ja bereits rechts eine Textbox.
Nach dem "Einlesen/Importieren" werden automatisch die Zeilen von Zeile 4 bis zur letzten gefüllten Zelle gezählt und durch die vorgegebene Zeilenmenge pro Flp geteilt. Anschließend wird der Wert dann in der Textbox angegeben. Steht meine ich ja auch schon in dem Bild "Es sind XX Sendungen vorhanden. Es können daher XX Flp´s erstellt werden". 
Daher würde dort bei 10 Datenzeilen angezeigt das man 0 Flp´s erstellen kann.

Wichtig war es, das alle gefüllten Zellen von Zelle 4 bis zur letzten gefüllten Kopiert werden und jeder Wert nur einmal vorkommt. Was mit deinem Code ja auch umgesetzt wird, denke ich zumindest ;-), kontrolliert habe ich es noch nicht.

Und was die "Formatierung" der CSV Datei angeht wird das bereits nachdem Importieren gemacht.
Sobald ich deinen Code zum abspeichern drin habe muss ich nur noch Prüfen ob die gespeicherte Datei zur weiteren Verarbeitung in das Datenprogramm fehlerfrei importiert werden kann.

VG


----------



## Pr3d4tor (13. Mai 2021)

Yaslaw hat gesagt.:


> Achja, eine einfache Funktion zum exportieren. Kann man gemütlich aus der Schleife pro FLP aufrufen


Ich befürchte dafür bin ich zu blöd ;-)
Egal wo ich den Aufruf für exportWs einfüge, ich erhalte immer die Meldung "Argument ist nicht Optional"

Aber mittlerweile verstehe ich immer mehr warum manche immer so auf eine Beispiel Datei bestehen :-D

Ein weiteres Problem für mich ist das Erstellen des kompletten Dateinamens. Der Dateiname setzt sich aus mehreren Variablen zusammen und wird, wie du ebenfalls dem Bild entnehmen kannst, auch bereits vorab in der Userform dargestellt. In meiner Ursprungsversion, als es zu Testzwecken eine Datei war, wurde zum Speichern "tbxFilename" genutzt.

Er setzt sich wie folgt zusammen: (Das sind nur Teilauszüge. Die entsprechenden Zellen werden natürlich auf Veränderungen überwacht usw. es soll nur Aufzeigen wie sich der Namen zusammen setzt.)

```
strUser = Environ("USERNAME")
flpName = vbNullString
pstrTime = Format(Now, "YYYYMMDDhhmmss")
pstrRelation = Worksheets("Tabelle2").Cells(3, 5).Value
pstrNR = "00"
txtFlp.Text = pstrNR
tbxFilename = EX_PFAD & "\" & strUser & "_" & pstrRelation & "_" & pstrTime & ".csv"

'EX_PFAD
Const EX_PFAD As String = "C:\Users\Public\cda\cup\vF\BDV"

'pstrRelation unter anderem durch
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim l As Long
    Dim r As Long
    If Not Application.Intersect(Target, Range("$E$1")) Is Nothing Then
    ' * UserForm übergibt den ausgewählten Namen der CSV an die Zelle E1
    pstrInt = Worksheets("Tabelle2").Cells(1, 5).Value 
        If pstrInt > 0 Then
            l = InStr(pstrInt, "_") + 1
            r = InStrRev(pstrInt, "_", 20)
        ' * Der Dateiname wird auf den relevanten Teil gekürzt
        pstrX = Mid(pstrInt, l, r - l)
        End If
        Worksheets("Tabelle2").Cells(3, 5).Value = pstrX ' * Hier wird der gerade erstellte Teil für den Dateinamen an die Zelle E3 übergeben.
End If
End Sub

'pstrNR
Private Sub txtFlp_Change()
    pstrNR = Format(txtFlp, "00")
    tbxFilename = EX_PFAD & "\" & strUser & "_" & pstrRelation & "_" & pstrTime & ".csv"
End Sub
```
Wie ich dein FLP_NR jetzt noch mit (strUser & "_" & pstrRelation & "_" & pstrTime & ".csv) in

```
Dim wbTarget As Workbook:       Set wbTarget = Workbooks.Add        'Neues Workbook
    ioWs.Copy Before:=wbTarget.Sheets(1)
    wbTarget.SaveAs filePath
    wbTarget.Close
```
Einbinden ist mir noch nicht ganz klar.
Den Pfad habe ich aus dem EX_PFAD kopiert und für filePath genutzt aber das mit dem Namen kann ich leider auch nicht testen da wie gesagt exportWs noch nicht funzt. Und ich Aufgrund der mehrfachen Erstellung auch nicht wüsste wie ich die FLP_NR als Variable in die Userform bekommen sollte. Mit einem Namen gings ja noch aber mehrere Beispielname.......

VG


----------



## Pr3d4tor (16. Mai 2021)

Nabend oder besser guten Morgen,
ich wollte mal kurz nen kleines Update bringen.

Also ich habe es mittlerweile dann doch mal geschafft @Yaslaw seine Function zum Speichern der einzelnen Tabellenblätter in eine eigene Mappe zu nutzen. Außerdem habe ich es auch hinbekommen den Dateinamen inkl. Pfad an meine Wünsche anzupassen. Sogar das Anzeigen der Flp Nr. aus der Function herraus in meine Userform habe ich schließlich am Ende hinbekomme.

Hier mal die Codes:

```
'Den Anfang habe ich mal hier weggelassen da der komplette Code ja hier im Beitrag zu finden ist'
'
'
        'Die Datenzeilen kopieren
        wsSrc.Range( _
            wsSrc.Cells(flpStartRow, C_DATA_FIRST_COL), _
            wsSrc.Cells(flpEndRow, C_DATA_LAST_COL) _
        ).Copy wsFlp.Cells(C_HEAD_ROWS + 1, 1)

    'Die einzelnen Flp Tabellen werden durch den Aufruf von Call exportWS in einzelne Arbeitsmappe gespeichert
    Call exportWs(wsFlp, flpNr&)
    Next
End Sub


'/**
' * Exportiert eine einzelne Exceltabelle
' * @param  Worksheet   Die zu exportierende Tabelle
' * @param  Long        Die FLP-Nummer
' */
Public Sub exportWs(ByRef ioWs As Worksheet, ByVal iFlpNr&)
    Dim filePath$:                  filePath = "C:\Users\Public\cda\cup\vF\BDV\" & strUser & "_" & pstrRelation & "_" & "FLP_" & iFlpNr & "_" & pstrTime & ".csv" 'TODO: Pfad anpassen
  
    'Prüfen ob bereits vorhanden, ggf löschen
    If Dir(filePath) <> "" Then
        If MsgBox("File " & filePath & " already exists." & vbCrLf & "overwrite?", vbYesNo + vbCritical) = vbNo Then Exit Sub
        Kill filePath
    End If
  
    Dim wbTarget As Workbook:       Set wbTarget = Workbooks.Add        'Neues Workbook
    ioWs.Copy Before:=wbTarget.Sheets(1)
    wbTarget.SaveAs filePath
    wbTarget.Close
End Sub
```

Das es bisher in den Tests lief gehe ich mal davon aus das der Aufruf mit "Call exportWs(wsFlp, flpNr&)" richtig ist oder gibt es noch eine bessere Methode?Alle meine anderen Tests haben dazu geführt das entweder nur einen Tabellenblatt in eine neue Mappe exportiert wurde oder aber nach dem ersten Durchlauf ein zweiter stattfand aber man weiß ja nie ;-)

Zwei Fragen habe ich allerdings dann doch noch daher ich selbst noch kein Ergebnis erzielen konnte.
1. Wie muss ich den Code für die FLPs umstellen damit immer eine Flp bzw. Tabelle mehr erstellt wird als angegeben? in dieser sollen sich ja die restlichen Zeilen befinden. 

Also die Eingabe von:
2 erstellt 3 Flp´s ( 2 Flp´s mit den voreingestellten Datenzeilen + 1Flp mit den restlichen Zeilen)
3 erstellt 4 Flp´s ( 3 Flp´s mit den voreingestellten Datenzeilen + 1Flp mit den restlichen Zeilen)
4 erstellt 5 Flp´s ( 4 Flp´s mit den voreingestellten Datenzeilen + 1Flp mit den restlichen Zeilen) usw.

2. Kann man das eigentlich auch so Angeben das FLP_1 oder FLP_2 durch FLP_01 oder FLP_02 ersetzt wird? (Das allerdings kein muss, sondern mehr Neugier zu Lernzwecken).

Wäre cool, wenn mir jemand bei Frage 1 weiterhelfen kann und vorab schon mal ein riesen Danke
schön an alle, besonders an @Yaslaw für seine Codes.


VG


----------



## Yaslaw (19. Mai 2021)

Wie ist der Stand? Hast du die Tage schon selber Lösungen gefunden?


----------



## Pr3d4tor (21. Mai 2021)

Yaslaw hat gesagt.:


> Wie ist der Stand? Hast du die Tage schon selber Lösungen gefunden?


Letzter bzw. aktueller Stand ist folgender:

Makro läuft bisher problemlos durch und erfüllt seinen Zweck ;-)

*Zu 1:*
Konnte ich Lösen, vielleicht etwas umständlich oder unschön, aber was besser ist mir (noch) nicht eingefallen. Ich habe die Eingabe in der txtFlp an eine Zelle weitergegeben und in einer weiteren mit 1 addieren lassen. Das Ergebnis übernimmt dann die Funktion als Anzahl der zu erstellenden Flps.
So wird aus Eingabe 5 automatisch 6 usw. was andere ist mir bisher nicht eingefallen und löst ja auch im Grunde das Problem.

*Zu 2:*
war wie gesagt nicht wirklich Wichtig/Erforderlich, hätte mich nur interessiert. Daher noch nicht gelöst und wird vielleicht später nochmal in Angriff genommen.

*Neu hinzugekommen: ;-)*
Aufgrund der doch recht verschiedenen Dateien aus denen die Flps mal erstellt werden sollen hat sich nun folgendes Ergeben.
Im Moment überlege ich ob man den festen Wert _"Const C_FLP_SIZE_DEFAULT& = 15"_ auch noch irgendwie "erweitern" oder "variabler" gestalten kann. Das Makro zählt ja zu Beginn erst einmal alle Zeilen von 4 an bis zu letzten gefüllten und teilt diesen Wert dann durch den Wert der "Size_Default".
Nun überlege ich ob man vielleicht hingeht bzw. das so in den Code einbauen kann, dass:

- Wenn der errechnete Wert für die maximalen Flps = < 5 dann _"Const C_FLP_SIZE_DEFAULT& = 15"_
- Wenn der errechnete Wert für die maximalen Flps = > 5 dann _"Const C_FLP_SIZE_DEFAULT& = 20"_
- Wenn Wert = < 10 dann _"Const C_FLP_SIZE_DEFAULT& = 30"_ usw.

Oder ob man den Code so lässt und vielleicht zusätzlich noch eine Textbox "Gewünschte Anzahl an Sendungen pro Flp" (Textbox = txtFlpVar) in die Userform packt um eine freie Eingabe für die "Size_Default" zu ermöglich.

Also z.B.: wenn _txtFlpVar < = 0_ oder auch, wenn _txtFlpVar ="" dann "Const C_FLP_SIZE_DEFAULT& = 15"_
ansonsten Wert von _txtFlpVar_ als Default übernehmen. Aber das hat sich auch wirklich erst heute Nachmittag ergeben daher habe ich in diese Richtung noch gar nichts Versucht.

VG


----------



## Zvoni (21. Mai 2021)

Freie Eingabe würde ich nicht machen, wenn du wirklich de facto feste Werte für dein SIZE_DEFAULT haben willst.
Würde dann eher mit einem Array arbeiten, und anstatt ner Const dann zwangsläufig eine Variable.

Übrigens: Das ist Unfug (mal schauen, ob du den Fehler siehst....):
Wenn Flps<=5 Dann SIZE=15
Wenn Flps>=5 Dann SIZE=20


----------



## Pr3d4tor (21. Mai 2021)

Zvoni hat gesagt.:


> Freie Eingabe würde ich nicht machen, wenn du wirklich de facto feste Werte für dein SIZE_DEFAULT haben willst.
> Würde dann eher mit einem Array arbeiten, und anstatt ner Const dann zwangsläufig eine Variable.


Naja die "freie" Eingabe sollte ja schon, denke ich zumindest, eingeschränkt sein.
Dachte da halt an sowas wie EIN default Wert welcher eben bei Bedarf einmalig durch eine Benutzereingabe "überschrieben" werden kann. Nach dem Durchlauf würde dann wieder die Default gelten.

Ich werde mich aber mal mit dem Array beschäftigen, mal schauen ob ich da was hinbekomme.
Vielleicht hat @Yaslaw ja auch noch ne "verrückte" Idee ;-)



Zvoni hat gesagt.:


> Übrigens: Das ist Unfug (mal schauen, ob du den Fehler siehst....):
> Wenn Flps<=5 Dann SIZE=15
> Wenn Flps>=5 Dann SIZE=20


Wie war das noch gleich.... War Blöd, merkste selbst ne? :-D
Vielleicht sollte ich ausführliche Rückmeldungen nicht kurz vor Schicht beginn schreiben, da bleibt dann nicht viel Zeit zum Korrekturlesen.


----------



## Yaslaw (21. Mai 2021)

Boah, ist das ein chaotisch verstümmelten Code den du da postest. Keine Ahnung was das soll, aber so hast du gartantiert Kompilierungsfehler.  Irgendwelchen Code und dann beginnt eine Funktion. Gibt für mich viel zu raten um mir ein Bild zu machen, wie dein Code aussehen könnte.



zu 1)
Mein Code macht doch schon ein Tab mit dem Rest drin. Ist also bereits gelöst, ausser du hast den Teil so zerrissen wie den unlesbaren Code den du gepostet hast

zu 2)

```
wsFlp.Name = "FLP_" & format(flpNr, "00")

flpsize:
[code=vb]
Public Function getFlpSize&(ByVal iFlpCount&)
    If iFlpCount < 5 Then getFlpSize = 15: Exit Function
    If iFlpCount < 10 Then getFlpSize = 20: Exit Function
    getFlpSize = 30
End Function[/vb]
```


----------



## Pr3d4tor (24. Mai 2021)

Yaslaw hat gesagt.:


> Boah, ist das ein chaotisch verstümmelten Code den du da postest. Keine Ahnung was das soll, aber so hast du gartantiert Kompilierungsfehler.  Irgendwelchen Code und dann beginnt eine Funktion. Gibt für mich viel zu raten um mir ein Bild zu machen, wie dein Code aussehen könnte.
> Anhang anzeigen 66633


Ich hatte extra erwähnt, dass das nur Teilauszüge sind wie sich der Dateiname schlussendlich zusammensetzt ;-) allerdings konntet ich dieses Problem im späteren Verlauf ja selbst lösen, was ich im Übrigen auch erwähnt habe.


Yaslaw hat gesagt.:


> zu 1)
> Mein Code macht doch schon ein Tab mit dem Rest drin. Ist also bereits gelöst, ausser du hast den Teil so zerrissen wie den unlesbaren Code den du gepostet hast


Bin mir gerade nicht wirklich sicher worauf das bezogen ist.
Falls du aber damit deinen Code bezüglich der Aufteilung meinst, ja der hat schon eine Tabelle mit dem Rest erstellt. Allerdings wollte ich ja erreichen das immer eine mehr Erstellt wird als in der Textbox angegeben, so dass man immer die gewählte Anzahl erhält plus der letzten Tabelle mit dem Rest.
Konnte ich ja aber über Umwege auch lösen.

Deine Code habe ich 1 zu 1 so übernommen .....



Yaslaw hat gesagt.:


> zu 2)
> 
> ```
> wsFlp.Name = "FLP_" & format(flpNr, "00")
> ...


Werde ich mich bei Zeiten mal mit beschäftigen. Mal schauen ob ich das so eingebaut bekomme das es am Ende wie gewünscht läuft. Denke ja mal das es hier nicht 1 zu 1 geht bzw. nicht ohne Veränderungen vom anderen Code und/oder dem "Aufruf" an der richtigen Stelle ;-)

Wie immer vielen Dank für deine Bemühungen und
allen einen schöne Rest Pfingstmontag.

VG


----------

