Steelbox
10-06-2016, 06:13 AM
Hallo,
Ik heb een probleempje met mijn code. ik heb een code nodig die values van cellen van het ene blad naar het andere kopieerd. Ik heb een loop nodig die dit doet tot hij terug aan de value van de eerste cell komt en dan stopt. Ik heb een code gemaakt die werkt, maar als ik aan de code andere voorwaarden hang, blijft de loop doorlopen. In de code hieronder ben ik opzoek naar cellen waar "1 X" in voorkomt bv "1 X kast". als ik mijn code dan aanpas om bv "2 X" te vinden blijft de loop doorlopen en kopieren en plakken. Niet echt ideaal :p.
Dim A As Range
Sheet5.Activate
Cells.Find(what:="1 X ", after:=ActiveCell, LookIn:=xlValues, lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext, MatchCase:=False _
, searchformat:=False).Copy
ActiveCell.Select
Set A = ActiveCell
Sheet75.Activate
row_number = row_number + 1
Cells(row_number, 2).Select
ActiveCell.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
Do
Blad5.Activate
Cells.FindNext(after:=ActiveCell).Select
Cells.FindNext(after:=ActiveCell).Copy
Sheet75.Activate
row_number = row_number + 1
Cells(row_number, 2).Select
ActiveCell.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
Loop Until ActiveCell.Value = A.Value
Alvast bedankt
Ik heb een probleempje met mijn code. ik heb een code nodig die values van cellen van het ene blad naar het andere kopieerd. Ik heb een loop nodig die dit doet tot hij terug aan de value van de eerste cell komt en dan stopt. Ik heb een code gemaakt die werkt, maar als ik aan de code andere voorwaarden hang, blijft de loop doorlopen. In de code hieronder ben ik opzoek naar cellen waar "1 X" in voorkomt bv "1 X kast". als ik mijn code dan aanpas om bv "2 X" te vinden blijft de loop doorlopen en kopieren en plakken. Niet echt ideaal :p.
Dim A As Range
Sheet5.Activate
Cells.Find(what:="1 X ", after:=ActiveCell, LookIn:=xlValues, lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext, MatchCase:=False _
, searchformat:=False).Copy
ActiveCell.Select
Set A = ActiveCell
Sheet75.Activate
row_number = row_number + 1
Cells(row_number, 2).Select
ActiveCell.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
Do
Blad5.Activate
Cells.FindNext(after:=ActiveCell).Select
Cells.FindNext(after:=ActiveCell).Copy
Sheet75.Activate
row_number = row_number + 1
Cells(row_number, 2).Select
ActiveCell.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
Loop Until ActiveCell.Value = A.Value
Alvast bedankt