Hallo,

zum Punkt 1:

Das Feld "Datum" wurde eingetragen, da sich der Datenbereich um eine Spalte verschoben hat.

Das Fehlverhalten wurde beseitigt.

zum Punkt 2:

Reg-Nr. wurde mit aufgenommen in die zu kopierenden Daten

zum Punkt 3:

In die Splte H wird in die Zell-Eigenschaft FormulaR1C1 folgende Formel eingetragen:

=IF(RC[-1]=3300,RC[-3]*1.07,RC[-3]*1.19)

das entspricht für Zelle H2: =WENN(G2=3300;E2*1,07;E2*1,19)

Zitat: Zelle H2 Funktion =Wenn(F3=3300;D2*1,07;D2*1,19)

Hier wird mit F3 eine Zelle in der nächsten Zeile abgefragt. Ich habe es als Tippfehler angesehen.

Falls es dennoch bewusst kein Tippfehler sein sollte, muss die Formel im Code wie folgt angepasst werden:

=IF(R[1]C[-1]=3300,RC[-3]*1.07,RC[-3]*1.19)

das entspricht für Zelle H2: =WENN(G3=3300;E2*1,07;E2*1,19)

Die Spalten haben sich durch das Einfügen der Angabe "Reg-Nr." um eins nach Rechts verschoben.

Hier der komplette VBA-Code:

Option Explicit

Sub AnalyzeAndCopy()
    Dim wsh As Worksheet
    Dim rngChk As Range
    Dim rngData As Range
    Dim wshNew As Worksheet
    Set wsh = ThisWorkbook.Worksheets(1)
    
    ' Von H3 bis Spalte T alles Scannen
    Set rngData = wsh.Range(wsh.Range("H3"), wsh.Cells(wsh.UsedRange.Count + wsh.UsedRange.Top, 24))
    For Each rngChk In rngData.Cells
        If Not rngChk.Value = "" Then
            If wshNew Is Nothing Then
                Set wshNew = CreateNewWorkbook
            End If
            AddNewValue wshNew, rngChk
        End If
    Next
End Sub

Function CreateNewWorkbook() As Worksheet
    Dim wbk As Workbook
    Dim wsh As Worksheet
    
    Set wbk = Application.Workbooks.Add()
    Set wsh = wbk.Worksheets(1)
    
    wsh.Range("A1").Value = "kreditor"
    wsh.Range("B1").Value = "kunde"
    wsh.Range("C1").Value = "Rg-Nr."
    With wsh.Range("D:D")
        .Cells(1, 1).Value = "datum"
        .NumberFormat = "m/d/yyyy"
    End With
    With wsh.Range("E:E")
        .Cells(1, 1).Value = "betrag"
        .NumberFormat = "_-* #,##0.00 [$€-407]_-;-* #,##0.00 [$€-407]_-;_-* ""-""?? [$€-407]_-;_-@_-"
    End With
    
    wsh.Range("F1").Value = "kostenstelle"
    wsh.Range("G1").Value = "gegenkonto"
    
    With wsh.Range("H:H")
        .Cells(1, 1).Value = "brutto"
        .NumberFormat = "_-* #,##0.00 [$€-407]_-;-* #,##0.00 [$€-407]_-;_-* ""-""?? [$€-407]_-;_-@_-"
    End With
    Set CreateNewWorkbook = wsh
End Function

Sub AddNewValue(wshOutSheet As Worksheet, rngMoney As Range)
    Dim rngWrite As Range
    Dim rngKreditor As Range
    Set rngWrite = wshOutSheet.Cells(wshOutSheet.UsedRange.Rows.Count + 1, 1)
    ' Kreditor in Spalte D
    Set rngKreditor = rngMoney.Worksheet.Cells(rngMoney.Row, 4)
    
    ' Kreditor
    rngWrite.Value = rngKreditor.Value
    ' Kunde
    rngWrite.Offset(ColumnOffset:=1).Value = rngKreditor.Offset(ColumnOffset:=1).Value
    ' Reg-Nr.
    rngWrite.Offset(ColumnOffset:=2).Value = rngKreditor.Offset(ColumnOffset:=2).Value
    ' Datum
    rngWrite.Offset(ColumnOffset:=3).Value = rngKreditor.Offset(ColumnOffset:=3).Value
    ' Betrag
    rngWrite.Offset(ColumnOffset:=4).Value = rngMoney.Value
    ' Kostenstelle
    rngWrite.Offset(ColumnOffset:=5).Value = rngMoney.EntireColumn.Cells(1, 1).Value
    ' Gegenkonto
    rngWrite.Offset(ColumnOffset:=6).Value = rngMoney.EntireColumn.Cells(2, 1).Value
    ' Berechnungsformel
    rngWrite.Offset(ColumnOffset:=7).FormulaR1C1 = "=IF(RC[-1]=3300,RC[-3]*1.07,RC[-3]*1.19)"
    ' rngWrite.Offset(ColumnOffset:=7).FormulaR1C1 = "=IF(R[1]C[-1]=3300,RC[-3]*1.07,RC[-3]*1.19)"
End Sub

LG, BigBen