AW: Anderung Makro daten verschieben
25.07.2006 12:22:22
fcs
Hallo Karel,
hättest ja auch schon etwas früher sagen können, dass du verschiedene Werte für die Zahl bzw. den Buchstaben eingeben können möchtest.
In der neuen Fassung werden die gewünschte Zahl und der Buchstabe für die zu verschiebenden Zeilen in einer Eingabebox abgefragt.
gruss Franz
Sub Daten_verschieben_2()
Dim LN, r2, r3, Zahl As Double, Buchstabe As String
' z von zeile 5 bis 22
r2 = 5 ' 1. Zeile zum Einfügen von Daten in Tabelle 2
r3 = 5 ' 1. Zeile zum Einfügen von Daten in Tabelle 3
Zahl = Val(InputBox("Bitte Zahl eingeben" & vbLf & vbLf & _
"Zeilen mit Wert größer Zahl in Spalte A werden verschoben", _
"Daten verschieben - Zahlwerteingabe", 0))
Buchstabe = InputBox("Bitte Buchstabe eingeben" & vbLf & vbLf & _
"Zeilen mit Buchstrabe in Spalte A werden verschoben", _
"Daten verschieben - Buchstabeneingabe", "x")
If Buchstabe = "" Then Exit Sub 'Abbrechen wurde angeklickt
For LN = 5 To 22
If IsNumeric(Cells(LN, 1)) Then
If Cells(LN, 1) > Zahl Then
With Sheets(3)
'spalte 2 ist B
Range(Cells(LN, 1), Cells(LN, 2)).Copy
.Cells(r3, 2).PasteSpecial Paste:=xlValues
Range(Cells(LN, 4), Cells(LN, 7)).Copy
.Cells(r3, 5).PasteSpecial Paste:=xlValues
r3 = r3 + 1
End With
End If
Else
If Cells(LN, 1) = Buchstabe Then
With Sheets(2)
'spalte 2 ist B
Range(Cells(LN, 1), Cells(LN, 2)).Copy
.Cells(r2, 2).PasteSpecial Paste:=xlValues
Range(Cells(LN, 4), Cells(LN, 7)).Copy
.Cells(r2, 5).PasteSpecial Paste:=xlValues
r2 = r2 + 1
End With
End If
End If
Next LN
Application.CutCopyMode = False
End Sub