Problem mit VBA Code - Werte aus Zellen in andere Zeilen übertragen

[Mike4711]

    Hallo Profis,

ich bin sicher, das es hier ne Menge davon gibt und mir einer davon helfen kann. :)

Ich bin purer Anfänger in VBA-Codes.
Ich habe mit unterem Code folgendes Problem:

Es sollen mehrere Zellwerte kopiert werden und im gleichem Tabellenblatt ab A7 bis F7 eingefügt werden.
Der Code funktioniert soweit "Ja", doch er soll beim nächsten Aufruf unter der nächst freien Zeile (also unter A7) die Werte eintragen. Das klappt bei also noch nicht, es wird immer wieder die Zeile A7 bis F7 überschrieben. :(

Ich hoffe, das mir jemand hier schnell eine Lösung geben kann. Vielleicht gibt es auch noch einen besseren Code?

Hier mein Code:

Code:

Sub Nächster_Artikel()
  Dim wksEingabe As Worksheet
  Dim wksListe As Worksheet
  Dim lngZeile As Long, rngZelle As Range
  
  Set wksEingabe = Worksheets("Einkauf")  'Eingabetabellenblatt
  Set wksListe = Worksheets("Einkauf")      'Tabellenblatt in das die Daten geschrieben werden _
sollen
  
  With wksListe
    'nächste freie Zeile in Liste
    Set rngZelle = .Cells.Find(What:="*", after:=.Range("A1"), LookIn:=xlFormulas, _
        lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
    If rngZelle Is Nothing Then
      lngZeile = 1
    Else
      lngZeile = rngZelle.Row + 1
    End If
    
    .Cells(lngZeile, 1).Value = wksEingabe.Range("K5")
    .Cells(lngZeile, 2).Value = wksEingabe.Range("K6")
    .Cells(lngZeile, 3).Value = wksEingabe.Range("K10")
    .Cells(lngZeile, 4).Value = wksEingabe.Range("K20")
    .Cells(lngZeile, 5).Value = wksEingabe.Range("K14")
    .Cells(lngZeile, 6).Value = wksEingabe.Range("K22")
    'usw.

  End With
End Sub

Ich habe mal einem Bildausschnitt hier mit beigefügt.

Ich hoffe, das sich jemand mit meinem Problem befassen möchte. :)

Ich bedanke mich jetzt schon ganz fest dafür.

Lg Mike

Code strukturiert dargestellt durch 3. Button von rechts im Beitragsformular: #
photo Raute_zps3ee56209.jpg
Moderator [Bild: smilie.php?smile_ID=1810]

[Rabe]

Hi Mike,

Ich bin purer Anfänger in VBA-Codes.
Ich habe mit unterem Code folgendes Problem:
[...]
Ich habe mal einem Bildausschnitt hier mit beigefügt.

Ich hoffe, das sich jemand mit meinem Problem befassen möchte. :)

es würden sich bestimmt ein paar mit Deinem Problem befassen wollen, aber wie sollen sie das Makro auf ein Bild anwenden, um es testen zu können?

Also stelle doch bitte (D)eine (Beispiel-)Tabelle als Excel-Datei zur Verfügung oder stelle die relevanten Ausschnitte hier dar, siehe die als Wichtige Themen markierten Forums-Beiträge!
Die farbigen Texte sind anklickbare Links:

Beitrag 1 Für Neulinge im Forum: Arbeitsmappen zur Verfügung stellen
Beitrag 2 Für Neulinge im Forum: Tabellenausschnitte im Forum einstellen

Sensible Daten können/sollten vor Einstellen anonymisiert werden.

[Rabe]

Hi Mike,

Es sollen mehrere Zellwerte kopiert werden und im gleichem Tabellenblatt ab A7 bis F7 eingefügt werden.
Der Code funktioniert soweit "Ja", doch er soll beim nächsten Aufruf unter der nächst freien Zeile (also unter A7) die Werte eintragen. Das klappt bei also noch nicht, es wird immer wieder die Zeile A7 bis F7 überschrieben. :(

Ich hoffe, das mir jemand hier schnell eine Lösung geben kann. Vielleicht gibt es auch noch einen besseren Code?

mit dem folgenden Code kann die letzte belegte Zeile in Spalte A bestimmt werden:

Code:

Dim loLetzte&

'letzte benutzte Zelle anhand Spalte A feststellen
loLetzte = Cells(Rows.Count, 1).End(xlUp).Row

diese wird dann anstelle der Variablen "lngZeile" im Code (wegen WITH-Schleife mit Punkt vor Cells) verwendet, dann schreibt Excel immer in die erste freie Zeile:

Code:

Dim loLetzte&

With wksListe
    'letzte benutzte Zelle anhand Spalte A feststellen
    loLetzte = .Cells(Rows.Count, 1).End(xlUp).Row
    
    'erste freie Zelle:
    loLetzte = loLetzte + 1
    
    .Cells(loLetzte, 1).Value = wksEingabe.Range("K5")
    .Cells(loLetzte, 2).Value = wksEingabe.Range("K6")
    .Cells(loLetzte, 3).Value = wksEingabe.Range("K10")
    .Cells(loLetzte, 4).Value = wksEingabe.Range("K20")
    .Cells(loLetzte, 5).Value = wksEingabe.Range("K14")
    .Cells(loLetzte, 6).Value = wksEingabe.Range("K22")
    'usw.

[Kuwer]

Hallo Mike,

Du willst doch nur in Spalte A auf die letzte belegte Zelle prüfen, also musst Du das auch so schreiben.

Statt Set rngZelle = .Cells.Find(What:="*", ...
also Set rngZelle = .Columns(1).Find(What:="*", ...

Gruß Uwe

[Mike4711]

Hallo Rabe,

an welcher stelle soll ich das in meinem Code einsetzen?

Lg Mie

[Mike4711]

Hallo, ich habe es hin bekommen,

mit diesem Code und er packt es immer unter die nächste Zeile.

Code:

Sub Nächster_Artikel()
    Dim i As Long
    Const NewConstSheet As String = "Einkauf"
    Dim bfound As Boolean
    Dim sMerk As String
    Dim sMaxZeile As Long
    Dim TB As Worksheet
    
    Application.ScreenUpdating = False
    
    'Prüfen ob Tabelle NewConstSheet schon angelegt ist
    For i = 1 To ActiveWorkbook.Sheets.Count
        If ActiveWorkbook.Sheets(i).Name = NewConstSheet Then
            bfound = True
            Exit For
        End If
    Next i
    
    'wenn nicht dann anlegen
    If bfound = False Then
        sMerk = ActiveWorkbook.ActiveSheet.Name
        ActiveWorkbook.Sheets.Add after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
        ActiveWorkbook.ActiveSheet.Name = NewConstSheet
        ActiveWorkbook.Sheets(sMerk).Activate
    End If
    
    Set TB = ActiveWorkbook.Sheets(NewConstSheet)
    
    'nächste leere Zeile ermitteln
    sMaxZeile = TB.Cells(TB.Rows.Count, 2).End(xlUp).Row + 1
    
    'Daten in neue Tabelle übertragen
    TB.Cells(sMaxZeile, 1) = ActiveWorkbook.ActiveSheet.Range("K5")
    TB.Cells(sMaxZeile, 2) = ActiveWorkbook.ActiveSheet.Range("K6")
    TB.Cells(sMaxZeile, 3) = ActiveWorkbook.ActiveSheet.Range("K10")
    TB.Cells(sMaxZeile, 4) = ActiveWorkbook.ActiveSheet.Range("K20")
    TB.Cells(sMaxZeile, 5) = ActiveWorkbook.ActiveSheet.Range("K14")
    TB.Cells(sMaxZeile, 6) = ActiveWorkbook.ActiveSheet.Range("K22")
    
    Application.ScreenUpdating = True
End Sub

[schauan]

Hallo Mike,

mal unabhängig von eventuellen weiteren Verbesserungsmöglichkeiten zwei Tips.

(1) Wenn Du was mit dem aktiven Blatt machen willst, dann brauchst Du das meist nicht anzugeben. ActiveWorkbook und ActiveSheet kannst Du Dir meistens sparen.
(2) Wenn Du mehrere Aktionen mit einem Objekt, hier z.B. einem Blatt, ausführen willst, gibt es das WITH. Wichtig dabei ist, dass dann der codeteil, der sich auf das mit WITH angesprochene Objekt bezieht, mit einem Punkt beginnt - siehe hier ".Cells" bzw. weiter oben Ralf's code.

Code:

[code]With ActiveWorkbook.Sheets(NewConstSheet)
.Cells(sMaxZeile, 1) = Range("K5")
...
End With
[/code]