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

Beiträge aus den Excel-Beispielen zum Thema "Nur letzte zeile übertragen"