Option
Explicit
Sub
VNummernausleiten_click()
Dim
i
As
Long
Dim
z
As
Long
Sheets(
"Angebot"
).Activate
i = 10
z = 15
Do
Until
Cells(i, 5).Value =
"Stopp"
If
Len(Cells(i, 5).Value) = 11 _
And
(Left(Cells(i, 5).Value, 1) =
"V"
_
Or
Left(Cells(i, 5).Value, 1) =
"v"
)
Then
Cells(i, 5).
Select
Selection.Copy
Rem hat hier nix tu suchen, sonst bleibt z immer 15
Rem z = 15
Sheets(
"Technisches Datenblatt"
).
Select
Cells(z, 1).Insert
Rem Application.CutCopyMode =
False
_
And
z = z + 20
Rem der Unterstrich zur Befehlszeilen verkoppelung ?
Rem nur ein Tippfehler ???
Rem interessant, dass der Interpreter hier mitmacht !
Application.CutCopyMode =
False
z = z + 20
Rem Cells(i, 5) zeigt auf Sheets(
"Angebot"
)
Rem daher zurück ZumZum
Sheets(
"Angebot"
).Activate
End
If
i = i + 1
Loop
MsgBox
"Artikelnummern erfolgreich kopiert!"
End
Sub
Sub
EinfachundGeschmacklos()
Dim
i
As
Long
Dim
z
As
Long
i = 10
z = 15
Do
Until
Sheets(
"Angebot"
).Cells(i, 5).Value =
"Stopp"
If
IstWahr(Sheets(
"Angebot"
).Cells(i, 5).Value)
Then
Sheets(
"Angebot"
).Cells(i, 5).Copy _
Destination:=Sheets(
"Technisches Datenblatt"
).Cells(z, 1)
z = z + 20
End
If
i = i + 1
Loop
End
Sub
Function
IstWahr(Wert
As
String
)
As
Boolean
If
Len(Wert) <> 11
Then
Exit
Function
If
UCase(Left(Wert, 1)) =
"V"
Then
IstWahr =
True
End
Function