VBA Code Anpassung resp. Ergänzung

[danielhuszka]

Guten Morgen miteinander

In folgenden Datei habe ich eine Probleme:

Das Blatt "Archiv" soll zwei weiteren Spalten haben (siehe Bsp-Datei angehängt) nämlich "Kundenname" sowie "Kundennummer", um beim Auslieferung auch nach weiteren Kundendaten Filtern zu können.
Die Daten dazu sollte die VBA vom "Ausgang" K17" - Kundenname und vom "K20" - Kundennummer holen. ACHTUNG: Die 2 extra-Spalten habe bereits eingefügt, somit verschiebt sich automatisch alles bereits (Anpassung natürlich erwünscht, sonst funktioniert nicht ordnungsgemäss). Als weiteres ist eine zusätzliche "Filter-Fenster" angedacht. Wie gehen das?

Kann jemand da weiterhelfen? Habe versucht, irgendwo habe ich aber die Faden verloren..


ACHTUNG: Die 2 extra-Spalten habe bereits eingefügt, somit verschiebt sich automatisch alles bereits (Anpassung natürlich erwünscht, sonst funktioniert nicht ordnungsgemäss)

Code wie folgt:

Sub Archive()


Dim sht As Worksheet
Dim LastRow As Long
Dim KitNummer As String


Set sht = Worksheets("Archiv")
AusgangLastRow = Worksheets("Ausgang").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
ArchiveLastRow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
'MsgBox LastRow
ArchiveFirstRow = ArchiveLastRow + 1

ArchiveRowIndex = ArchiveFirstRow

'Worksheets("Archiv").Range("A2:K120").Clear

KitNummer = "001"
For i = 3 To AusgangLastRow
If Worksheets("Ausgang").Range("A" & i).value = "" And Worksheets("Ausgang").Range("H" & i).value = "" Then Exit For
Worksheets("Archiv").Range("A" & ArchiveRowIndex).value = Worksheets("Ausgang").Range("K8").value & " - " & Worksheets("Ausgang").Range("K11").value

If Worksheets("Ausgang").Range("H" & i).value <> KitNummer And Worksheets("Ausgang").Range("H" & i).value <> "" Then

    KitNummer = Worksheets("Ausgang").Range("H" & i).value
    Worksheets("Archiv").Range("B" & ArchiveRowIndex).value = KitNummer
   
Else
Worksheets("Archiv").Range("B" & ArchiveRowIndex).value = KitNummer
End If

Worksheets("Archiv").Range("B" & ArchiveRowIndex).value = KitNummer
Worksheets("Archiv").Range("C" & ArchiveRowIndex).value = Worksheets("Ausgang").Range("A" & i).value
Worksheets("Archiv").Range("D" & ArchiveRowIndex).value = Worksheets("Ausgang").Range("B" & i).value
Worksheets("Archiv").Range("E" & ArchiveRowIndex).value = Worksheets("Ausgang").Range("C" & i).value
Worksheets("Archiv").Range("F" & ArchiveRowIndex).value = Worksheets("Ausgang").Range("D" & i).value
Worksheets("Archiv").Range("G" & ArchiveRowIndex).value = Worksheets("Ausgang").Range("E" & i).value
Worksheets("Archiv").Range("H" & ArchiveRowIndex).value = Worksheets("Ausgang").Range("F" & i).value
Worksheets("Archiv").Range("I" & ArchiveRowIndex).value = Worksheets("Ausgang").Range("G" & i).value
'Worksheets("Archiv").Range("J" & ArchiveRowIndex).value = Worksheets("Ausgang").Range("K8").value
ArchiveRowIndex = ArchiveRowIndex + 1

Debug.Print (KitNummer)
Next i

End Sub


DANKE für EURE Hilfe und einen schönen Tag!

[schauan]

Hallöchen,

ich habe Deine Datei erst mal nicht angeschaut, nur den Code. In Deinem Code holst Du nix aus K17 und K20. In zwei zeilen hast Du feste zelladressen programmiert, eine davon ist

Worksheets("Archiv").Range("A" & ArchiveRowIndex).value = Worksheets("Ausgang").Range("K8").value & " - " & Worksheets("Ausgang").Range("K11").value

die andere ist auskommentiert ...

[danielhuszka]

Lieber schauan

Besten Dank für deine Antwort.

Vielleicht habe ich mich etwas falsch ausgedruckt, entschuldigung. Im Datei ist sichtbar, dass die zwei "extra-Spalten" eingefügt worden, jedoch noch nichts angepasst gehabt. Meine Frage geht generell, um einen Lösungsvorschlag resp. Code-"Ergänzung/Anpassung". Mir ist es bekannt, dass bereits aus K17 und K20 nichts geholt wird, das wäre ja noch ein Zusatzoption.

Danke im Voraus

[schauan]

Hallöchen,

in Deinem Code füllst Du doch jede Spalte, da steht doch

Worksheets("Archiv").Range("B" & ArchiveRowIndex).value = KitNummer
Worksheets("Archiv").Range("C" & ArchiveRowIndex).value = Worksheets("Ausgang").Range("A" & i).value
Worksheets("Archiv").Range("D" & ArchiveRowIndex).value = Worksheets("Ausgang").Range("B" & i).value
Worksheets("Archiv").Range("E" & ArchiveRowIndex).value = Worksheets("Ausgang").Range("C" & i).value
Worksheets("Archiv").Range("F" & ArchiveRowIndex).value = Worksheets("Ausgang").Range("D" & i).value
Worksheets("Archiv").Range("G" & ArchiveRowIndex).value = Worksheets("Ausgang").Range("E" & i).value
Worksheets("Archiv").Range("H" & ArchiveRowIndex).value = Worksheets("Ausgang").Range("F" & i).value
Worksheets("Archiv").Range("I" & ArchiveRowIndex).value = Worksheets("Ausgang").Range("G" & i).value
'Worksheets("Archiv").Range("J" & ArchiveRowIndex).value = Worksheets("Ausgang").Range("K8").value

Wenn Du nun vorne was eingefügt hast, musst Du die Spaltenbezeichnung entsprechend weiter rücken. Aus B wird dann D usw., das sollte doch recht einfach sein.

Und auch die Übernahme aus festen Zellen hast Du schon dabei, ich sagte es bereits.
Du hast
'Worksheets("Archiv").Range("J" & ArchiveRowIndex).value = Worksheets("Ausgang").Range("K8").value

Das könnte dann so umgesetzt werden

Worksheets("Archiv").Range("A" & ArchiveRowIndex).value = Worksheets("Ausgang").Range("K17").value