VBA Belegnummer Täglich durchnummerieren

[Seafunks]

Hallo, 

ich habe 2 Belege, die ich mit meine Tabelle erstelle. Einmal Angebote und einmal Auftragsbestätigungen. Jeder Beleg wird Tageweise durchnummeriert. 
Sprich  29.03.2021 Angebot 1, Angebot 2, Angebot 3  - 28.03.2021 Angebot 1, Angebot 2, Angebot 3
Das gleiche dann auch für Auftragsbestätigung. 
Ich habe nun sowohl für Angebote als auch für Auftragsbestätigung ein extra Tabellenblatt gemacht.  Wo ich die Nummerierung und auch die anderen 2 Kriterien (aus der sich die Belegnummer zusammensetzt) mittels VBA während der Belegerstellung eintragen lasse. Gleichzeitig ziehe ich mir aus diesem Tabellenblatt dann die Belegnummer für meinen Beleg. 

1. Das Löschen der alten Zeilen funktioniert bei der Auftragsbestätigung (Counter OC)  aber nicht bei dem Angebot (Counter QT). Ich sehe bis auf QT und OC keinen unterschied in den Codes.  Vielleicht bin ich ja auch einfach nur Blind.

Der Code funktioniert

Code:

If Sheets("Counter OC").Range("A2").Value <> "" Then
    Do While Sheets("Counter OC").Range("A2").Value <> Sheets("Tabelle1").Range("H4") Or Sheets("Counter OC").Range("A2").Value <> ""
    Sheets("Counter OC").Rows("2").Delete
    Loop
Else
End If

Der Code Funktioniert nicht

Code:

If Sheets("Counter QT").Range("A2").Value <> "" Then
    Do While Sheets("Counter QT").Range("A2").Value <> Sheets("Tabelle1").Range("H4") Or Sheets("Counter QT").Range("A2").Value <> ""
    Sheets("Counter QT").Rows("2").Delete
    Loop
Else
End If

2. Wenn ich die 3 Kriterien für die Belegnummer in die extra Tabellenblätter geschrieben habe. Möchte ich die Zusammen natürlich in meinen Beleg als komplette Belegnummer einfügen. 
Excel überträgt dabei immer die Daten der vorletzten Zeile und nicht der letzten Zeile (die ich kurz vorher erstellt habe)

Code:

Set last = Sheets("Counter OC").Range("a65536").End(xlUp).Row + 1


Sheets("Tabelle1").Range("G3").Value = Sheets("Counter OC").Cells(last, 2).Value & "-" & Sheets("Counter OC").Cells(last, 1).Value & "-" & Sheets("Counter OC").Cells(last, 3).Value

Tabelle 1 = mein Beleg


Hier der komplette Code 

Code:

Private Sub BelegNummer_Click()

'Auftragsbestätigung

Do While Sheets("Tabelle1").Range("C1") = "Auftragsbestätigung"

Sheets("Counter OC").Unprotect

If Sheets("Counter OC").Range("A2").Value <> "" Then
    Do While Sheets("Counter OC").Range("A2").Value <> Sheets("Tabelle1").Range("H4") Or Sheets("Counter OC").Range("A2").Value <> ""
    Sheets("Counter OC").Rows("2").Delete
    Loop
Else
End If

Set lastrow = Sheets("Counter OC").Range("a65536").End(xlUp).Row + 1


Sheets("Counter OC").Cells(lastrow, 1).Value = Sheets("Tabelle1").Range("H4")
Sheets("Counter OC").Cells(lastrow, 2).Value = "OC"
Sheets("Counter OC").Cells(lastrow, 3).Value = lastrow - 1

Set last = Sheets("Counter OC").Range("a65536").End(xlUp).Row + 1


Sheets("Tabelle1").Range("G3").Value = Sheets("Counter OC").Cells(last, 2).Value & "-" & Sheets("Counter OC").Cells(last, 1).Value & "-" & Sheets("Counter OC").Cells(last, 3).Value

Set lastrow = Nothing
Set last = Nothing

Sheets("Counter OC").Protect





'Angebot

Do While Sheets("Tabelle1").Range("C1") = "Angebot"

Sheets("Counter QT").Unprotect

If Sheets("Counter QT").Range("A2").Value <> "" Then
    Do While Sheets("Counter QT").Range("A2").Value <> Sheets("Tabelle1").Range("H4") Or Sheets("Counter QT").Range("A2").Value <> ""
    Sheets("Counter QT").Rows("2").Delete
    Loop
Else
End If

Set lastrow = Sheets("Counter QT").Range("a65536").End(xlUp).Row + 1


Sheets("Counter QT").Cells(lastrow, 1).Value = Sheets("Tabelle1").Range("H4")
Sheets("Counter QT").Cells(lastrow, 2).Value = "QT"
Sheets("Counter QT").Cells(lastrow, 3).Value = lastrow - 1

Set last = Sheets("Counter QT").Range("a65536").End(xlUp).Row + 1

Set Wert1 = Sheets("Counter QT").Cells(last, 2) & "-" & Sheets("Counter QT").Cells(last, 1) & "-" & Sheets("Counter QT").Cells(last, 3)

Sheets("Tabelle1").Cells("G3").Value = Wert1

Set lastrow = Nothing
Set last = Nothing
Set Wert1 = Nothing

Sheets("Counter QT").Protect


End Sub

[Steffl]

Hallo,

ich glaube, dein Code ist nicht komplett, ich meine da fehlen 2 Loops.

[Seafunks]

Hallo, 

danke, kurz gegoogelt, ja Do While ist wohl nur mit loop. Das ist nicht beabsichtigt. Jetzt mit IF ersetzt.

Wenn ich stattdessen If nutze, ändert sich an der Funktionsweise irgendwie nichts. 

100% des Codes, so wie er jetzt zusammengebaut ist habe ich mir ergoogelt und dann durch try and error modifiziert. 
Meine VBA Kenntnisse sind sehr begrenzt, dafür kann ich mit google umgehen.
War sehr lustig, als ich 

Code:

Or Sheets("Counter OC").Range("A2").Value <> ""

den Teil beim löschen der Zeile noch nicht im Code hatte und Excel mir dauerhaft die leere Zeile gelöscht hat. Da half dann nur noch der Taskmanager

Code mit IF statt Do While

Code:

Private Sub BelegNummer_Click()

'Auftragsbestätigung

If Sheets("Tabelle1").Range("C1") = "Auftragsbestätigung" Then


Sheets("Counter OC").Unprotect

If Sheets("Counter OC").Range("A2").Value <> "" Then
    Do While Sheets("Counter OC").Range("A2").Value <> Sheets("Tabelle1").Range("H4") Or Sheets("Counter OC").Range("A2").Value <> ""
    Sheets("Counter OC").Rows("2").Delete
    Loop
Else
End If

Set lastrow = Sheets("Counter OC").Range("a65536").End(xlUp).Row + 1


Sheets("Counter OC").Cells(lastrow, 1).Value = Sheets("Tabelle1").Range("H4")
Sheets("Counter OC").Cells(lastrow, 2).Value = "OC"
Sheets("Counter OC").Cells(lastrow, 3).Value = lastrow - 1

Set last = Sheets("Counter OC").Range("a65536").End(xlUp).Row + 1


Sheets("Tabelle1").Range("G3").Value = Sheets("Counter OC").Cells(last, 2).Value & "-" & Sheets("Counter OC").Cells(last, 1).Value & "-" & Sheets("Counter OC").Cells(last, 3).Value

Set lastrow = Nothing
Set last = Nothing

Sheets("Counter OC").Protect

Else
End If

'Angebot

If Sheets("Tabelle1").Range("C1") = "Angebot" Then

Sheets("Counter QT").Unprotect

If Sheets("Counter QT").Range("A2").Value <> "" Then
    Do While Sheets("Counter QT").Range("A2").Value <> Sheets("Tabelle1").Range("H4") Or Sheets("Counter QT").Range("A2").Value <> ""
    Sheets("Counter QT").Rows("2").Delete
    Loop
Else
End If

Set lastrow = Sheets("Counter QT").Range("a65536").End(xlUp).Row + 1


Sheets("Counter QT").Cells(lastrow, 1).Value = Sheets("Tabelle1").Range("H4")
Sheets("Counter QT").Cells(lastrow, 2).Value = "QT"
Sheets("Counter QT").Cells(lastrow, 3).Value = lastrow - 1

Set last = Sheets("Counter QT").Range("a65536").End(xlUp).Row + 1

Set Wert1 = Sheets("Counter QT").Cells(last, 2) & "-" & Sheets("Counter QT").Cells(last, 1) & "-" & Sheets("Counter QT").Cells(last, 3)

Sheets("Tabelle1").Cells("G3").Value = Wert1

Set lastrow = Nothing
Set last = Nothing
Set Wert1 = Nothing

Sheets("Counter QT").Protect

Else
End If

End Sub

[Steffl]

Hallo,

IMHO fehlt da noch ein Value (2 mal!)

Code:

Sheets("Tabelle1").Range("H4").Value

und wieso verwendest Du das Set bei den Variablen LastRow und Last und wo sind die Variablen überhaupt deklariert?