Hi,

Am Mon, 7 Dec 2020 10:29:25 -0800 (PST) schrieb Xxer Xxes:

Any sugestion here, please ? ..

try:

With DestWks
For Each myCell In myRng1.Cells
If myCell < 3 Then
myCell = myCell.Value + 1
Else
myCell.Offset(0, -4).Cut _
Destination:=.Cells(myCell.Row, Columns.Count).End(xlToLeft).Offset(0, 1)
End If
Next myCell
Application.CutCopyMode = False
Application.ScreenUpdating = True
End With


Regards
Claus B.
--
Windows10
Office 2016