# Thread: Cut and copy range... (2000 sr 1)

1. ## Cut and copy range... (2000 sr 1)

Hi Hans this is a part of your code to compare 2 sheet, copy delete ecc...
Now i would want to arrange this piece of code to cut all remain line when the macro go after Loop statement.
(assuming the remain line to cut and copy are into range A:J)

in effect cut the remain line from S2 = "DEP_A" range A:J....
end paste into S3 = "STORICO" from the last cells free

this is the line to arrange into comment '????????????????????????????

' Copy remaining rows from S1 to S2
PR = Sheets(S1).Range("A65536").End(xlUp).Row
If PR > 2 Then
Sheets(S1).Range("3:" & PR).Copy .Range("A" & N)
Sheets(S1).Range("3:" & PR).Delete
End If

end here the code:

Sub DEFINITE()

Dim N As Long, PR As Long, S1 As String, S2 As String, S3 As String
Dim Rng As Range

Application.ScreenUpdating = False

S1 = "DEP_B"
S2 = "DEP_A"
S3 = "STORICO"

N = 3

PR = Worksheets(S3).Range("A65536").End(xlUp).Row + 1

With Sheets(S2)
Do Until .Cells(N, 1) = ""
Set Rng = Sheets(S1).Range("G:G").Find(.Cells(N, 7))
If Rng Is Nothing Then
.Range(.Cells(N, 1), .Cells(N, 11)).Copy
Sheets(S3).Cells(PR, 1).PasteSpecial xlPasteValues
.Rows(N).Delete
PR = PR + 1
Else
Rng.EntireRow.Delete
N = N + 1
End If
Loop

'????????????????????????????????

'????????????????????????????????

End With

'Call DEFINITE_1

Application.ScreenUpdating = True

End Sub

2. ## Re: Cut and copy range... (2000 sr 1)

You should be able to work this out for yourself, Sal.

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•