Hi,
ich hatte zuletzt noch eine korrigierte Version gepostet, da mir der Fehler auch noch aufgefallen war. Hier nochmal eingearbeitet in deinen letzten Code:
Option Explicit
Public Sub Uebertrag_SBA_SBE()
Dim lng_zeile_quelle As Long
Dim lng_zeile_ziel As Long
Dim lng_spalte As Long
Dim lng_letzte_zeile_quelle As Long
Dim obj_wks_quelle As Worksheet
Dim obj_wks_ziel As Worksheet
Set obj_wks_quelle = Worksheets("Test")
Set obj_wks_ziel = Worksheets("Neu")
obj_wks_ziel.Range("A2:k5000").ClearContents ' Hier ggf. Zeilennummer erweitern
obj_wks_ziel.Range("A2:k5000").Interior.Color = xlNone
lng_zeile_quelle = 19
lng_zeile_ziel = 2
With obj_wks_quelle
lng_letzte_zeile_quelle = .Cells(1048576, 2).End(xlUp).Row
Do Until lng_zeile_quelle > lng_letzte_zeile_quelle
If .Cells(lng_zeile_quelle, 1) = "" And .Cells(lng_zeile_quelle, 2) "" Then
obj_wks_ziel.Cells(lng_zeile_ziel, 1) = .Cells(lng_zeile_quelle, 2)
obj_wks_ziel.Range("A" & lng_zeile_ziel & ":K" & lng_zeile_ziel).Interior.Color = _
vbYellow ' Farbe ggf. anpassen
lng_zeile_ziel = lng_zeile_ziel + 1
ElseIf .Cells(lng_zeile_quelle, 1) "" And .Cells(lng_zeile_quelle, 2) "" Then
lng_spalte = 16
Do Until .Cells(lng_zeile_quelle, lng_spalte) = ""
obj_wks_ziel.Cells(lng_zeile_ziel, 1) = .Cells(lng_zeile_quelle, 2) 'Kostenart
obj_wks_ziel.Cells(lng_zeile_ziel, 2) = .Cells(lng_zeile_quelle, 4) 'Kommentar
obj_wks_ziel.Cells(lng_zeile_ziel, 3) = .Cells(lng_zeile_quelle, 11) 'Zuordnung
obj_wks_ziel.Cells(lng_zeile_ziel, 4) = .Cells(lng_zeile_quelle, 12) 'MWST-Satz
obj_wks_ziel.Cells(lng_zeile_ziel, 5) = .Cells(lng_zeile_quelle, 13) 'Fä _
lligkeit Tag
If .Cells(lng_zeile_quelle, 13) = "" Then obj_wks_ziel.Cells(lng_zeile_ziel, 5). _
Interior.Color = vbRed 'Farbliche Markierung, falls kein Fälligkeitstag eingetragen wurde
obj_wks_ziel.Cells(lng_zeile_ziel, 6) = .Cells(lng_zeile_quelle, lng_spalte) ' _
Umsatz netto
obj_wks_ziel.Cells(lng_zeile_ziel, 7) = .Cells(lng_zeile_quelle, lng_spalte) * ( _
1 + .Cells(lng_zeile_quelle, 12)) 'Umsatz brutto
obj_wks_ziel.Cells(lng_zeile_ziel, 8) = DateSerial(Year(.Cells(10, lng_spalte)), _
Month(.Cells(10, lng_spalte)), .Cells(lng_zeile_quelle, 13)) 'Fälligkeit Datum
obj_wks_ziel.Cells(lng_zeile_ziel, 9) = Year(.Cells(10, lng_spalte)) & "-" & _
Format(Month(.Cells(10, lng_spalte)), "00") 'Fälligkeit Monat
obj_wks_ziel.Cells(lng_zeile_ziel, 10) = DateSerial(Year(.Cells(10, lng_spalte)) _
, Month(.Cells(10, lng_spalte)), .Cells(lng_zeile_quelle, 13)) 'Fälligkeit KW
If .Cells(lng_zeile_quelle, 13) "" Then
If WorksheetFunction.IsoWeekNum(DateSerial(Year(.Cells(10, lng_spalte)), _
Month(.Cells(10, lng_spalte)), .Cells(lng_zeile_quelle, 13))) = 1 _
And Month(.Cells(10, lng_spalte)) = 12 Then
obj_wks_ziel.Cells(lng_zeile_ziel, 10) = Year(.Cells(10, lng_spalte) _
) + 1 & "-" & Format(WorksheetFunction.IsoWeekNum(DateSerial(Year(.Cells(10, lng_spalte)), Month(.Cells(10, lng_spalte)), .Cells(lng_zeile_quelle, 13))), "00") _
Else
obj_wks_ziel.Cells(lng_zeile_ziel, 10) = Year(.Cells(10, lng_spalte)) & _
"-" & Format(WorksheetFunction.IsoWeekNum(DateSerial(Year(.Cells(10, lng_spalte)), Month(.Cells(10, lng_spalte)), .Cells(lng_zeile_quelle, 13))), "00")
End If
Else
obj_wks_ziel.Cells(lng_zeile_ziel, 10) = ""
obj_wks_ziel.Cells(lng_zeile_ziel, 10).Interior.Color = vbRed
End If
obj_wks_ziel.Cells(lng_zeile_ziel, 11) = obj_wks_ziel.Cells(lng_zeile_ziel, 3) & _
" " & obj_wks_ziel.Cells(lng_zeile_ziel, 10) 'Suchkriterium Zuordnung Liqui
lng_spalte = lng_spalte + 1
lng_zeile_ziel = lng_zeile_ziel + 1
Loop
lng_zeile_ziel = lng_zeile_ziel + 1
End If
lng_zeile_quelle = lng_zeile_quelle + 1
Loop
End With
End Sub
Gruß
Regina