Clever-Excel-Forum

Seiten: 1 2

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

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

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

Hallo Thomas,

die Beispieltabelle bringt ja mächtig viel, wenn die Erfassungstabelle leer ist. Undecided

Wie soll man da jetzt wissen, woran es liegt/lag. Huh

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

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

Gruß Uwe

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

Ohne Code Tags ?

Hallo snb,

was meinst du damit?

Schöne Grüße

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

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

Seiten: 1 2

Thomas78

joshua

joshua

Thomas78

Kuwer

Thomas78

snb

Thomas78

snb

Thomas78