kann mir jemand weiterhelfen?
Wie kann ich mit einer Schleifenanweisung die Felder z.B.
B2 bis F2
B3 ... F3
...
...
B40 bis F40
von Tabelle1 nach Tabelle2 kopieren?
Viele Dank im Voraus!
fjudy
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'die erste Zeile ändere ich mal nicht, ABER:
'bist du sicher, dass du bei JEDEM selection-Change einen Schleifendurchlauf
'haben willst? Ich hätt das ganze eher auf einen Button gesetzt, oder auf worksheet.activate
Dim lRowFirstSource As Long
Dim lRowFirstTarget As Long
Dim lRowLastTarget As Long
Dim lCounter As Long
Dim wksSource As Worksheet
Dim wksTarget As Worksheet
lRowFirstSource = 17 'in "StdAbr" gehts ab Zeile 17 los (da A4 = C17)
lRowFirstTarget = 4 'in "Übertrag" gehts ab Zeile 4 los (da A4 = C17)
Set wksSource = Tabelle0305 'hier kommen die Zahlen her
Set wksTarget = Tabelle2 'hier kommen die Zahlen hin
'If ActiveWorkbook.Name = "Stork-Stdnw_2013.01.xlsm" Then
'den versteh ich nicht. Was bringt das? auskommentiert.
Application.ScreenUpdating = False 'Bildschirmflackern verhindern
With Sheets("Übertrag")
'letzte Zeile feststellen
lRowLastTarget = .Cells(Rows.Count, 1).End(xlUp).Row
For lCounter = lRowFirstTarget To lRowLastTarget 'zeilen durchzählen
'Werte setzen
.Range("A" & lCounter).Value = wksSource.Range("C" & lCounter + lRowFirstSource - _
lRowFirstTarget - 1)
.Range("B" & lCounter).Value = wksSource.Range("D" & lCounter + lRowFirstSource - _
lRowFirstTarget - 1)
.Range("C" & lCounter).Value = wksSource.Range("F" & lCounter + lRowFirstSource - _
lRowFirstTarget - 1)
.Range("D" & lCounter).Value = wksSource.Range("L" & lCounter + lRowFirstSource - _
lRowFirstTarget - 1)
'lCounter zählt von 4 bis 13 (in diesem Beispiel)
'Erster durchlauf setzt auf A4, da lcounter gleich 4, den Wert aus Tabelle 0305 Zeile _
17 denn:
'lCounter (4) plus lRowFirstSource (17) - lRowFirstTarget (4) - 1 ist gleich 17
'zweiter Durchlauf ebenso, aber eins höher
Next lCounter
End With
'End If
'Block-IF auskommentiert (siehe oben)
Application.ScreenUpdating = True 'Damit du wieder siehst was du machst
End Sub
Grüße,