Liebe Leute,
ich bin langsam am Verzweifeln. Hier mein Programm:
posNo(1) = "0000"
posNo(2) = "9"
posNo(3) = "0301"
posNo(4) = "0302"
posNo(5) = "x" '"0305"
posNo(6) = "x" '"0320"
posNo(7) = "0341"
posNo(8) = "0342"
posNo(9) = "x" '"0345"
posNo(10) = "0360"
posNo(11) = "0381"
posNo(12) = "0382"
posNo(13) = "0401"
posNo(14) = "0402"
posNo(15) = "0451"
posNo(16) = "0452"
posNo(17) = "x" '"0465"
posNo(18) = "x" '"0466"
posNo(19) = "x" '"0467"
posNo(20) = "x" '"0468"
posNo(21) = "0471"
posNo(22) = "0472"
posNo(23) = "0481"
posNo(24) = "0482"
Worksheets(1).Activate
counter = 0
With Worksheets(1).Range("a2:a" & lastRow)
Set rng = .Find(9, LookIn:=xlValues)
If Not rng Is Nothing Then
firstAddress9 = rng.Address
Do
counter = counter + 1
Set rng = .FindNext(rng)
If rng Is Nothing Then
GoTo DoneFinding9
End If
Loop While Not rng Is Nothing And rng.Address <> firstAddress9
End If
DoneFinding9:
End With
For counterVar = 1 To counter
For controlVar = 1 To 24
With Worksheets(1).Range("a2:a" & lastRow)
Set rng = Nothing
Set rng = .Find(posNo(controlVar), LookIn:=xlValues)
MsgBox posNo(controlVar)
If Not rng Is Nothing Then
firstAddress = rng.Address
Do
MsgBox rng
rng.Select
cellRow = ActiveCell.Row
cellColumn = ActiveCell.Column
Cells(cellRow, cellColumn).EntireRow.Select
Selection.Cut
Sheets("Etikettenformate").Select
lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(lastRow, 1).Select
ActiveSheet.Paste
Worksheets(1).Activate
lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
x = counterVar * controlVar
Range("a2:a" & lastRow).Select
If rng Is Nothing Then
GoTo DoneFinding
End If
Loop While Not rng Is Nothing And rng.Address <> firstAddress
End If
DoneFinding:
End With
Next controlVar
Next counterVar |