Fortlaufende Nummerierung aber mit 2 Buchstaben
14.05.2018 07:33:01
Zoe401
ich stehe vor einem Problem, bei dem ich Hilfe eure Hilfe gebrauchen könnte.
Ich habe zwei Tabellen, in welche Daten von einerm anderen Arbeitsblatt kopiert werden.
In der einen Tabelle wird dazu jeweils eine fortlaufende Nummer erstellt und in der zweiten Tabelle werden die Proben nicht mit Nummern aufgelistet sondern mit Buchtaben. Jeweils zwei. Wir stehen im Moment irgendwo bei CS und es soll automatisch weiter "nummerieren" mit CT, CU, CV, CW, CX, CY, CZ, DA, DB usw.
Mein Code für die Nummerierung un das kopieren der Daten in Tabelle 1 (Probenübersicht - Zahlen) ist wie folgt. Tabelle 2 heisst (Probenübersicht - Buchstaben).
Sub NeueProbe1()
Dim wbProbenübersicht As Workbook
Dim wbProtokollvorlage As Workbook
Dim wksStart As Worksheet
Set wbProtokollvorlage = ThisWorkbook
Set wksStart = wbProtokollvorlage.Sheets("Startseite")
Dim wksTarget As Worksheet
Dim i As Integer
i = wbProtokollvorlage.Sheets("Startseite").TextBox1.Value
On Error Resume Next
Set wbProbenübersicht = Workbooks("Probenübersicht.xlsx")
On Error GoTo 0
If wbProbenübersicht Is Nothing Then
Set wbProbenübersicht = Workbooks.Open _
("C:\Users\kiesel\Desktop\Protokoll Vorlagen Test\Probenübersicht.xlsx")
End If
Select Case True
Case wbProtokollvorlage.Sheets("Startseite").CheckBox28
Set wksTarget = wbProbenübersicht.Sheets("Probenübersicht - Zahlen")
Case wbProtokollvorlage.Sheets("Startseite").CheckBox29
Set wksTarget = wbProbenübersicht.Sheets("Probenübersicht - Buchstaben")
End Select
wksTarget.Activate
For a = 1 To i
wksTarget.Cells(5, 1).End(xlDown).Offset(1, 0).Value = wksTarget.Cells(5, 1).End(xlDown). _
Offset(0, 0).Value + 1
wbProtokollvorlage.Sheets("Startseite").Range("C4").Copy
wksTarget.Range("H" & wksTarget.Cells(5, 1).End(xlDown).Row).PasteSpecial Paste:= _
xlPasteValues
wbProtokollvorlage.Sheets("Startseite").Range("G20").Copy
wksTarget.Range("C" & wksTarget.Cells(5, 1).End(xlDown).Row).PasteSpecial Paste:= _
xlPasteValues
wbProtokollvorlage.Sheets("Startseite").Range("G6").Copy
wksTarget.Range("D" & wksTarget.Cells(5, 1).End(xlDown).Row).PasteSpecial Paste:= _
xlPasteValues
wbProtokollvorlage.Sheets("Startseite").Range("C27").Copy
wksTarget.Range("E" & wksTarget.Cells(5, 1).End(xlDown).Row).PasteSpecial Paste:= _
xlPasteValues
wbProtokollvorlage.Sheets("Startseite").Range("G6").Copy
wksTarget.Range("F" & wksTarget.Cells(5, 1).End(xlDown).Row).PasteSpecial Paste:= _
xlPasteValues
wksTarget.Range("G" & wksTarget.Cells(5, 1).End(xlDown).Row).Value = 1
wbProtokollvorlage.Sheets("Startseite").Range("C14").Copy
wksTarget.Range("I" & wksTarget.Cells(5, 1).End(xlDown).Row).PasteSpecial Paste:= _
xlPasteValues
wbProtokollvorlage.Sheets("Startseite").Range("C18").Copy
wksTarget.Range("J" & wksTarget.Cells(5, 1).End(xlDown).Row).PasteSpecial Paste:= _
xlPasteValues
wbProtokollvorlage.Sheets("Startseite").Range("G14").Copy
wksTarget.Range("K" & wksTarget.Cells(5, 1).End(xlDown).Row).PasteSpecial Paste:= _
xlPasteValues
Next a
End Sub
Viele Grüße,
Zoe