Herbers Excel-Forum - das Archiv

Nur letzte zeile übertragen

Bild

Betrifft: Nur letzte zeile übertragen
von: Yilmaz H.

Geschrieben am: 28.03.2005 15:43:24
Hallo,
ich habe ein VBA Code aus Forum bekommen, leider kann ich das nicht so anpassen, wie ich das gerne hätte. Folgendes Problem habe ich:
Aus der Tabelle "Verkaufte Artikel-Normal" soll nur der letzte Zeile nach Tabelle "Verkaufte Artikel" übertragen werden und nicht alle zeilen ab Zeile 10.
Hier der Code:
Sheets("Verkaufte Artikel-Normal").Activate
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Dim wks As Worksheet
Dim iQuell As Integer, iGetr As Integer
Dim lgZeile As Long, iZaehl As Integer
Set wks = Worksheets("Verkaufte Artikel")
'alle Zeilen in Verkaufte Artikel ab Zeile 10

'For lgZeile = 10 To Cells(65536, 1).End(xlUp).Offset(1, 0).Activate

'Ich glaube ich muss hier was machen, leider weis ich nicht wie!!!!!!
For lgZeile = 10 To Cells(65536, 1).End(xlUp).Row '(überträgt alle einzeln)


Range(Cells(lgZeile, 1), Cells(lgZeile, 6)).Copy wks.Cells(lgZeile, 1)
'alle "Getränke" in "Verkaufte Artikel Statistik"
For iGetr = 7 To 49
'alle Artikelbeschreibungen in "Verkaufte Artikel"
For iQuell = 8 To 60
If Cells(lgZeile, iQuell) = wks.Cells(9, iGetr) Then
iZaehl = iZaehl + Cells(lgZeile, iQuell - 1)
End If
Next
If iZaehl <> 0 Then
wks.Cells(lgZeile, iGetr) = iZaehl
Else
wks.Cells(lgZeile, iGetr) = ""
End If
iZaehl = 0
Next
Next
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Bild

Betrifft: AW: Nur letzte zeile übertragen
von: Paula

Geschrieben am: 28.03.2005 16:36:49
hi,
versuch es mit einer do...loop-Schleife
Dim lgZeile_Inhalt
Dim lgZeile As Integer
lgZeile = 10 'schleife fäng ab zeile nr. 10
Do Until IsEmpty(Cells(lgZeile, 1)) 'hochzählen bis zur nächsten leeren zelle
lgZeile = lgZeile + 1
Loop
lgZeile = lgZeile -1 'den ermittelten Zeilenwert um 1 verringern, da ja
'die zelle davor mit Inhalt gebraucht wird
Cells(lgZeile, 1).Select
lgZeile_Inhalt = Cells(lgZeile, 1) 'variable erhält den Inhalt der ermittelten Zelle
Worksheets("Verkaufte Artikel").Range("A1").Activate
lgZeile = 1 'schleife fäng ab zeile nr. 1,
'ermittelt wird jetzt lezte leere zelle
Do Until IsEmpty(Cells(lgZeile, 1)) 'hochzählen bis zur nächsten leeren zelle
lgZeile = lgZeile + 1
Loop
wks.Cells(lgZeile, 1) = lgZeile_Inhalt
Bild

Betrifft: AW: Nur letzte zeile übertragen
von: Paula

Geschrieben am: 28.03.2005 16:48:12
hi,
vergaß dass du nicht nur eine zelle sondern 6 in der gleichen Zeile,also:
Dim lgZeile As Integer
lgZeile = 10 'schleife fäng ab zeile nr. 10
Do Until IsEmpty(Cells(lgZeile, 1)) 'hochzählen bis zur nächsten leeren zelle
lgZeile = lgZeile + 1
Loop
lgZeile = lgZeile -1 'den ermittelten Zeilenwert um 1 verringern, da ja
'die zelle davor mit Inhalt gebraucht wird
Cells(lgZeile, 1).Select
Application.ScreenUpdating = False
Range(Cells(lgZeile, 1), Cells(lgZeile, 6)).Copy
Worksheets("Verkaufte Artikel").Range("A1").Activate
lgZeile = 1 'schleife fäng ab zeile nr. 1,
'ermittelt wird jetzt lezte leere zelle
Do Until IsEmpty(Cells(lgZeile, 1)) 'hochzählen bis zur nächsten leeren zelle
lgZeile = lgZeile + 1
Loop
wks.Range(Cells(lgZeile, 1), Cells(lgZeile, 6)).Select
Selection.Paste
Bild

Betrifft: Korrektur: Activate-Metode schlägt fehl
von: Paula

Geschrieben am: 28.03.2005 17:07:12
hi
hier der lauffähige Code

Dim wks As Worksheet
Dim iQuell As Integer, iGetr As Integer
Dim lgZeile As Long, iZaehl As Integer
Set wks = Worksheets("Verkaufte Artikel")
'alle Zeilen in Verkaufte Artikel ab Zeile 10
Dim lgZeile As Integer
Range("A1").Select
lgZeile = 10 'schleife fäng ab zeile nr. 10
Do Until IsEmpty(Cells(lgZeile, 1)) 'hochzählen bis zur nächsten leeren zelle
lgZeile = lgZeile + 1
Loop
lgZeile = lgZeile - 1 'den ermittelten Zeilenwert um 1 verringern, da ja
'die zelle davor mit Inhalt gebraucht wird
Cells(lgZeile, 1).Select
Application.ScreenUpdating = False
Range(Cells(lgZeile, 1), Cells(lgZeile, 6)).Copy
Worksheets("Verkaufte Artikel").Select
Range("A1").Select
lgZeile = 1 'schleife fäng ab zeile nr. 1,
'ermittelt wird jetzt lezte leere zelle
Do Until IsEmpty(Cells(lgZeile, 1)) 'hochzählen bis zur nächsten leeren zelle
lgZeile = lgZeile + 1
Loop
Worksheets("Verkaufte Artikel").Range(Cells(lgZeile, 1), Cells(lgZeile, 6)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.ScreenUpdating = True
... ... Der Rest von deinem Code
Bild

Betrifft: AW: Nur letzte zeile übertragen
von: Marcus Rose

Geschrieben am: 28.03.2005 17:01:29
Hallo,
versuche es einmal, indem Du folgende Zeilen austauschst:
For lgZeile = 10 To Cells(65536, 1).End(xlUp).Row '(überträgt alle einzeln)
gegen
lgZeile = IIf(IsEmpty(Range("A65536")), Range("A65536").End(xlUp).Row, 65536)
wenn Du den Code dann startest sollte Dir ein Fehler bei einem Next angezeigt werden. Dieses NEXT löschen.
Ich hoffe, dass Dein Problem damit gelöst ist.
Gruß
Marcus
http://xltreff.de
Bild

Betrifft: Bitte rückmelden, Danke
von: Paula
Geschrieben am: 28.03.2005 19:12:09
bd Paula
 Bild
Excel-Beispiele zum Thema "Nur letzte zeile übertragen"
Letzte nichtleere Zelle ermitteln Letzter Wert in Zeile
Letztes Speicherdatum eintragen Letzter Wert aus einem Bereich
Letztes Speicherdatum in die Fußzeile aller Tabellenblätter Formel bis zur letzten Zeile der Nebenspalte kopieren
Letzte Zelle mit Inhalt suchen Letzte Zelle einer Spalte mit Inhalt aus geschlossener Arbeitsmappe
Letzte Verknüpfung in einem Tabellenblatt löschen Letztes Zeichen der Werte einer Zellauswahl hoch-/tiefstellen