Excel VBA: Unterschiedliche Werte in unterschiedliche Blätter kopieren

[Härry_Otter]

Hallo zusammen!

Ich bitte um Hilfe bei folgendem Problem mit Excel 2010:
In Tabelle 1 soll eine bestimmte Reihe auf Zahlenwerte untersucht werden. Die Reihen, bei welchen die Zahlen über einem definierten Wert liegen, sollen in Tabelle 2 kopiert werden. Bei einer anderen Größendefinition, in ein anderes Tabellenblatt (hier Tabelle 3), bzw. nach weiteren Definitionen in weitere Blätter.

Nach stundenlanger Suche habe ich im Netz u.s. Code gefunden. Klappt auch super. Nur leider gelingt es mir nicht "dem Code begreiflich zu machen", dass er die Werte ab einer bestimmten Zeilennummer (z.B. ab Zeile 5) in die Zieltabellen einfügen soll. Die Werte werden immer ab Zeile 2 eingefügt.

Bin für jede Hilfestellung Dankbar!

Grüße, Guido

Private Sub CommandButton1_Click()
Dim lngI As Long
With Worksheets("Tabelle1")
For lngI = .Range("A65536").End(xlUp).Row To 2 Step -1
If .Cells(lngI, 6).Value > 70 Then
With Worksheets("Tabelle2")
Rows(lngI).Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
End With
End If
If .Cells(lngI, 6).Value > 49 And .Cells(lngI, 6).Value < 70 Then
With Worksheets("Tabelle3")
Rows(lngI).Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
End With
End If
Next lngI
End With
End Sub

_____________________________________________________________

Selbst gelöst. Sicher keine "Spezialisten-Lösung", aber es funzt:

Private Sub CommandButton1_Click()
Dim lngI As Long
Dim Z As Long
Dim X As Long
For Z = 1 To 3
Next Z
For X = 1 To 3
Next X
With Worksheets("Tabelle1")
For lngI = .Range("A65536").End(xlUp).Row To 2 Step -1
If .Cells(lngI, 6).Value > 70 Then
With Worksheets("Tabelle2")
Rows(lngI).Copy .Cells(.Range("A65536").End(xlUp).Offset(Z, 1).Row + 1, 1)
Z = 0
End With
End If
If .Cells(lngI, 6).Value > 49 And .Cells(lngI, 6).Value < 70 Then
With Worksheets("Tabelle3")
Rows(lngI).Copy .Cells(.Range("A65536").End(xlUp).Offset(X, 1).Row + 1, 1)
X = 0
End With
End If
Next lngI
End With
End Sub

Falls es eine "fachmännischere" Lösung geben sollte, würde ich mich trotzdem über eine Antwort freuen.

 

[OhNoIKilledMyHD]

Erstmal zu Deiner Lösung:

For Z = 1 To 3
 Next Z
 For X = 1 To 3
 Next X

ist nicht so elegant.

z=3
x=3

wäre sauberer.

Insgesamt könnte man es aber auch mit eigenen Zählern realisieren, ginge auch schneller, als jedes Mal
mit (.Range("A65536").End(xlUp) die letzte Zeile zu ermitteln.

Private Sub CommandButton1_Click()
Dim lngI As Long
Dim currentLineTable2 As Long
Dim currentLineTable3 As Long
currentLineTable2 = 5
currentLineTable3 = 5

With Worksheets("Tabelle1")


For lngI = .Range("A65536").End(xlUp).Row To 2 Step -1
If .Cells(lngI, 6).Value > 70 Then
With Worksheets("Tabelle2")

Rows(lngI).Copy .Cells(currentLineTable2, 1)
currentLineTable2 = currentLineTable2 + 1
End With
End If
If .Cells(lngI, 6).Value > 49 And .Cells(lngI, 6).Value < 70 Then
With Worksheets("Tabelle3")

Rows(lngI).Copy .Cells(currentLineTable3, 1)
currentLineTable3 = currentLineTable3 + 1
End With
End If
Next lngI
End With
End Sub

Ist es gewünscht, dass umgekehrt sortiert wird? (in der Ursprungslösung auch)

 

[cumulonimbus8]

sollen in Tabelle 2 kopiert werden

Ich möchte ungeachtet des VBA-Codes nachfragen ob du in der Tat eine statische Kopie in die Zielblätter bringen willst oder ob nicht normale Formelbezüge genügten wenn es nur darauf ankäme ein Resultat zu betrachten?
CN8