Hilfe bei Code für Button

[Thomas78]

Hallo zusammen,

Entschuldigung dass ich schon wieder was frage aber ich krieg den Code einfach nicht zum Laufen.

In der Datei seht ihr das ich einen Button im Arbeitsblatt "Erfassung" namens "Übertrag ins Archiv" habe. Mit diesem Button würde ich gerne die eingetragenen Daten in das Arbeitsblatt "Umsatzübersicht" übertragen.
(Rechnungsdatum, Kunde/Lieferant, Rechnungsnummer jeweils so oft wie Artikel eingetragen wurden).

Ich habe den Code glaub ich auch schon recht weit auf meine Datei anpassen können aber beim Übertrag der Werte hakt es noch.

Ich check einfach nicht was genau ich ändern muss, damit er mir die Werte problemlos in die Archivtabelle verschiebt. Die Komboboxen werden noch nach unten erweitert.

Kann mir hier bitte jemand weiterhelfen?

Vielen Dank

Thomas

[Gast 123]

Hallo Thomas

reiner Zufall das ich gerade ins Forum geschaut habe,  Das Makro gehört in ein normales Modulblatt, nicht in:  DieseArbeitsmappe 
Ich habe einige Fehler in den Range-Bereichen gefunden, deswegen habe ich unten ein Range-Bereich Test Makro angehangen.
Wenn du die Bereich zum Kopieren und Einfügen einzeln mit Range().Selet testest siehst du sofort den Unterschied.

lngErste = habe ich am Ende auf +2 gesetzt, sonst bleiben die ersten drei Zeilen immer frei.
Ich hoffe das Makro laeuft jetzt korrekt.  An der anderen Sache bin ich noch dran.

mfg  Gast 123

Code:

Sub Kopieren()
   Dim lngLetzte As Long
   Dim lngErste As Long
   ' Rechnungsdatum ist vorhanden
   If Range("C3") <> "" Then
       ' letzte belegte Zelle in Spalte 5 ermitteln
       lngLetzte = Application.CountA(Columns(5)) + 1
       ' Daten sind vorhanden
       If lngLetzte > 4 Then
           With Worksheets("Umsatzliste")
               ' erste freie Zeile in Spalte B ermitteln
               lngErste = Application.CountA(.Columns(7)) + 2   '5
               ' Spalten B:F kopieren
               Range(Cells(3, 5), Cells(lngLetzte, 6)).Copy
               ' in 1. freie Zeile Spalte E, nur Werte übertragen
               .Cells(lngErste, 7).PasteSpecial Paste:=xlValues
               ' Datum,. Lieferant und RN eintragen
               .Cells(lngErste, 3) = Range("C3")
               .Cells(lngErste, 4) = Range("C7")
               .Cells(lngErste, 5) = Range("C11")
           End With
           ' alle Daten löschen
           Range(Cells(5, 5), Cells(lngLetzte, 6)).ClearContents
           ' Rechnungsdatum, Lieferant, RN löschen
           Range("C3;C7;C11").ClearContents
           Application.CutCopyMode = False
       End If
   Else
       MsgBox "Bitte Rechnungsdatum eintragen"
   End If
End Sub

Sub Range_test()   'Test für Lösch-Bereich !!
  lngLetzte = Application.CountA(Columns(5)) + 1
  Range(Cells(5, 2), Cells(lngLetzte, 6)).Select  'ClearContents
End Sub

[Thomas78]

Hallo Gast 123,

wiedermal danke für deine Hilfe und schöne Grüße in den Schwarzwald.

Ich hab den Code mit deiner Hilfe fast fertig. Ich würde nur gerne noch ergänzen, dass für jeden Artikel der übertragen wird auch immer Rechnungsdatum (C3), Kunde/Lieferant (C7) und Rechnungsnummer (C11) übertragen wird und nicht nur einmal.

Das ist mein neuer Code:

Code:

Option Explicit

Sub Kopieren()
   Dim lngLetzte As Long
   Dim lngErste As Long

   ' Rechnungsdatum ist vorhanden
   If Range("C3") <> "" Then

       ' letzte belegte Zelle in Spalte 5 ermitteln
       lngLetzte = Application.CountA(Columns(5)) + 1

       ' Daten sind vorhanden
       If lngLetzte > 4 Then
           With Worksheets("Umsatzliste")

               ' erste freie Zeile in Spalte B ermitteln
               lngErste = Application.CountA(.Columns(7)) + 2   '5

               ' Spalte E kopieren
               Range(Cells(3, 5), Cells(lngLetzte, 5)).Copy

               ' in 1. freie Zeile Spalte G, nur Werte übertragen
               .Cells(lngErste, 7).PasteSpecial Paste:=xlValues

               ' Spalte G:I kopieren
               Range(Cells(3, 7), Cells(lngLetzte, 9)).Copy

               ' in 1. freie Zeile Spalte G, nur Werte übertragen
               .Cells(lngErste, 8).PasteSpecial Paste:=xlValues

               ' Datum,. Lieferant und RN eintragen
               .Cells(lngErste, 3) = Range("C3")
               .Cells(lngErste, 4) = Range("C7")
               .Cells(lngErste, 5) = Range("C11")
           End With

           ' alle Daten löschen
           Range(Cells(3, 3), Cells(lngLetzte, 9)).ClearContents

           ' Rechnungsdatum, Lieferant, RN löschen
           Range("C3,C7,C11").ClearContents
           Application.CutCopyMode = False
       End If
   Else
       MsgBox "Bitte Rechnungsdatum eintragen"
   End If
End Sub

Kann mir hier nochmal jemand auf die Sprünge helfen?

Vielen Dank!

Thomas

[Thomas78]

Habs jetzt selber geschafft,

vielen Dank an alle die sich Gedanken gemacht haben.

Thomas