Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

VBA Code Fehler
#1
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


Angehängte Dateien
.xlsm   Inventur (4).xlsm (Größe: 680,58 KB / Downloads: 5)
Antworten Top
#2
Versuch mal lngLetzte über "Umsätze.Cells(Rows.Count, "E").End(xlUp).Row" zu definieren.
Antworten Top
#3
Versuch mal lngLetzte über "Umsätze.Cells(Rows.Count, "E").End(xlUp).Row" zu definieren.
Antworten Top
#4
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
Antworten Top
#5
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
Antworten Top
#6
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
Antworten Top
#7
Ohne Code Tags ?
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Antworten Top
#8
Hallo snb,

was meinst du damit?

Schöne Grüße
Antworten Top
#9
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
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Antworten Top
#10
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
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste