Vorab Dank ich dir SEHR! :)

Habe den Code soweit angepasst, er funktioniert fast perfekt und wie ich es mir auch vorgestellt habe!

Bei ein oder zwei Sachen würde ich dich gerne um deine Mithilfe bitten. Aus diesem Grund habe ich dir noch mal die Original Quelldatei beigefügt:

  1. Seltsamerweise trägt er bei jedem neuen Sachverhalt eine überflüssige Zeile mit Datum in der Spalte F. Wie kriegt man diese unterdrückt?

  2. Ich würde gerne noch die Rg-Nr in der Spalte C haben wollen, der Rest verschiebt sich um eine Spalte nach rechts.

  3. In diesem Zusammenhang würde ich gerne in Erfahrung ob folgende Funktion auch direkt in die Spalte H eingebunden werden könnte:

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

Anbei würde ich dir gerne den etwas angepassten Code, den ich beim erzeugen der Datei zukommen lassen sowie die Excel Datei:

http://www68.zippyshare.com/v/69HaQ6LX/file.html

Sub AnalyzeAndCopy()

    Dim wsh As Worksheet
    Dim rngChk As Range
    Dim rngData As Range
    Dim wshNew As Worksheet
    Set wsh = ThisWorkbook.Worksheets(1)
     
    Set rngData = wsh.Range(wsh.Cells(3, 7), wsh.Cells(wsh.UsedRange.Count + wsh.UsedRange.Top, 20))
    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 = "Lieferant"
    
    With wsh.Range("C:C")
        .Cells(1, 1).Value = "Datum"
        .NumberFormat = "d/m"
    End With
    With wsh.Range("D:D")
        .Cells(1, 1).Value = "Netto"
        .NumberFormat = "_-* #,##0.00 [$€-407]_-;-* #,##0.00 [$€-407]_-;_-* ""-""?? [$€-407]_-;_-@_-"
    End With
     
    wsh.Range("E1").Value = "Kostenstelle"
    wsh.Range("F1").Value = "Gegenkonto"
    wsh.Range("G1").Value = "Rg-Nr"
    Set CreateNewWorkbook = wsh
End Function
 
Sub AddNewValue(wshOutSheet As Worksheet, rngMoney As Range)
    Dim rngWrite As Range
    Dim rngKreditor As Range
    Set rngWrite = Intersect(wshOutSheet.Range("A:A"), wshOutSheet.UsedRange).Offset(rowOffset:=1)
    Set rngWrite = wshOutSheet.Cells(wshOutSheet.UsedRange.Rows.Count + 1, 1)
    Set rngKreditor = rngMoney.Worksheet.Cells(rngMoney.Row, 4)
    rngWrite.Value = rngKreditor.Value
    rngWrite.Offset(ColumnOffset:=1).Value = rngKreditor.Offset(ColumnOffset:=1).Value
    rngWrite.Offset(ColumnOffset:=2).Value = rngKreditor.Offset(ColumnOffset:=3).Value
    rngWrite.Offset(ColumnOffset:=3).Value = rngMoney.Value
    rngWrite.Offset(ColumnOffset:=4).Value = rngMoney.EntireColumn.Cells(1, 1).Value
    rngWrite.Offset(ColumnOffset:=5).Value = rngMoney.EntireColumn.Cells(2, 1).Value
    
End Sub