VBA Code Fehler

[Thomas78]

Hallo liebes Forum,

ich habe leider ein Problem mit einem VBA Code. 
Folgender Code soll mir Daten von einer Erfassungstabelle in eine Umsatztabelle übertragen. Leider hört er in Zeile 12 der Umsatztabelle auf und trägt keine weiteren Daten ein, vorhandene werden einfach überschrieben.
Fehlermeldung wird mir keine angezeigt. Irgendwo habe ich wahrscheinlich einen Fehler bei der Ermittlung der letzten Zeile aber ich hab keine Ahnung wo.

Kann sich das bitte jemand anschauen? Die Umsatztabelle startet ab B4.

Code:

Option Explicit

Sub Kopieren()
   Dim lngLetzte As Long
   Dim lngErste As Long
   ' Rechnungsdatum ist vorhanden
   If Range("C4") <> "" Then
       ' letzte belegte Zelle in Spalte 5 ermitteln
       lngLetzte = Application.CountA(Columns(5)) + 2
       ' Daten sind vorhanden
       If lngLetzte > 3 Then
           With Worksheets("Umsätze")
               ' erste freie Zeile in Spalte B ermitteln
               lngErste = Application.CountA(.Columns(7)) + 3   '5
               ' Spalte F kopieren
               Range(Cells(4, 6), Cells(lngLetzte, 6)).Copy
               ' in 1. freie Zeile Spalte F, nur Werte übertragen
               .Cells(lngErste, 6).PasteSpecial Paste:=xlValues
               ' Spalte E kopieren
               Range(Cells(4, 5), Cells(lngLetzte, 5)).Copy
               ' in 1. freie Zeile Spalte C, nur Werte übertragen
               .Cells(lngErste, 3).PasteSpecial Paste:=xlValues
               ' Spalte H:J kopieren
               Range(Cells(4, 8), Cells(lngLetzte, 10)).Copy
               ' in 1. freie Zeile Spalte G:I, nur Werte übertragen
               .Cells(lngErste, 7).PasteSpecial Paste:=xlValues
               ' Datum,. Lieferant und RN eintragen
               .Range(.Cells(lngErste, 2), .Cells(lngErste + lngLetzte - 4, 2)) = Range("C4")
               .Range(.Cells(lngErste, 4), .Cells(lngErste + lngLetzte - 4, 4)) = Range("C8")
               .Range(.Cells(lngErste, 5), .Cells(lngErste + lngLetzte - 4, 5)) = Range("C12")
           End With
           ' alle Daten löschen
           Range(Cells(4, 5), Cells(lngLetzte, 6)).ClearContents
           Range(Cells(4, 8), Cells(lngLetzte, 10)).ClearContents
           ' Rechnungsdatum, Lieferant, RN löschen
           Range("C4,C8,C12").ClearContents
           Application.CutCopyMode = False
           Worksheets("Erfassung").Select
       End If
   Else
       MsgBox "Bitte Rechnungsdatum eintragen"
   End If
End Sub

Vielen Dank und schöne Grüße

[joshua]

Versuch mal lngLetzte über "Umsätze.Cells(Rows.Count, "E").End(xlUp).Row" zu definieren.

[joshua]

Versuch mal lngLetzte über "Umsätze.Cells(Rows.Count, "E").End(xlUp).Row" zu definieren.

[Thomas78]

Hallo Joshua,

danke. Du meinst statt:

lngLetzte = Application.CountA(Columns(5)) + 2

lngletzte = Umsätze.Cells(Rows.Count, "E").End(xlUp).Row

Schöne Grüße

[Kuwer]

Hallo Thomas,

die Beispieltabelle bringt ja mächtig viel, wenn die Erfassungstabelle leer ist.  
Wie soll man da jetzt wissen, woran es liegt/lag.  

Ich rate mal, dass nicht bei allen Datensätzen ein Lieferdatum steht/stand.

PS: Der Tipp von joshua ist nicht zielführend.

Gruß Uwe

[Thomas78]

Hallo Kuwer,

wie sollte ich die Erfassungstabelle sonst darstellen?

Der Fehler erscheint ja erst wenn man Daten aus der Erfassungstabelle mittels Button in die Umsatztabelle überträgt. Wenn ich also was eingebe wird zwar alles in die Umsatztabelle übernommen, aber bei der nächsten Eingabe überschrieben wenn mehr als 12 Zeilen in der Umsatztabelle ausgefüllt sind.

Schöne Grüße

Thomas

[snb]

Ohne Code Tags ?

[Thomas78]

Hallo snb,

was meinst du damit?

Schöne Grüße

[snb]

Wie es aussehen sollte:

Code:

Sub Kopieren()
   Dim lngLetzte As Long
   Dim lngErste As Long
   ' Rechnungsdatum ist vorhanden
   If Range("C4") <> "" Then
       ' letzte belegte Zelle in Spalte 5 ermitteln
       lngLetzte = Application.CountA(Columns(5)) + 2
       ' Daten sind vorhanden
       If lngLetzte > 3 Then
           With Worksheets("Umsätze")
               ' erste freie Zeile in Spalte B ermitteln
               lngErste = Application.CountA(.Columns(7)) + 3   '5
               ' Spalte F kopieren
               Range(Cells(4, 6), Cells(lngLetzte, 6)).Copy
               ' in 1. freie Zeile Spalte F, nur Werte übertragen
               .Cells(lngErste, 6).PasteSpecial Paste:=xlValues
               ' Spalte E kopieren
               Range(Cells(4, 5), Cells(lngLetzte, 5)).Copy
               ' in 1. freie Zeile Spalte C, nur Werte übertragen
               .Cells(lngErste, 3).PasteSpecial Paste:=xlValues
               ' Spalte H:J kopieren
               Range(Cells(4, 8), Cells(lngLetzte, 10)).Copy
               ' in 1. freie Zeile Spalte G:I, nur Werte übertragen
               .Cells(lngErste, 7).PasteSpecial Paste:=xlValues
               ' Datum,. Lieferant und RN eintragen
               .Range(.Cells(lngErste, 2), .Cells(lngErste + lngLetzte - 4, 2)) = Range("C4")
               .Range(.Cells(lngErste, 4), .Cells(lngErste + lngLetzte - 4, 4)) = Range("C8")
               .Range(.Cells(lngErste, 5), .Cells(lngErste + lngLetzte - 4, 5)) = Range("C12")
           End With
           ' alle Daten löschen
           Range(Cells(4, 5), Cells(lngLetzte, 6)).ClearContents
           Range(Cells(4, 8), Cells(lngLetzte, 10)).ClearContents
           ' Rechnungsdatum, Lieferant, RN löschen
           Range("C4,C8,C12").ClearContents
           Application.CutCopyMode = False
           Worksheets("Erfassung").Select
       End If
   Else
       MsgBox "Bitte Rechnungsdatum eintragen"
   End If
End Sub

[Thomas78]

Hallo snb,

ach du meinst die Art wie ich den Code in den Beitrag eingefügt habe?
Das tut mir leid.

Nächstes Mal weiß ich Bescheid.

Schöne Grüße Thomas