Using macros to cut & paste rows to a new worksheet

R

Richard_S

Hi all,

New to the forum here so be nice ;)

I'm after a little help here. What I want to acheive is this.

-For each row
if there are more than two occurences of the integer 2 in a se
range
{
then cut the entire row
paste the row at the first available position in worksheet B
}-

Basically I'm after a timesaver here as manuall cutting and pasting i
a real drag! I've not had much experience with macros & vb. I don'
mind getting my hands dirty with code though as I've coded in c/c++ fo
years.

Any help would be greatly appreciated

Cheers

Ric
 
F

Frank Kabel

Hi
try (watch for linebreaks):

Sub paste_delete_rows()
Dim last_row As Long
Dim row_index As Long
Dim target_wks As Worksheet
Dim source_wks As Worksheet
Dim target_row As Long

Set source_wks = ActiveSheet
Set target_wks = Worksheets("sheet2")

Application.ScreenUpdating = False
last_row = source_wks.Cells(Rows.Count, "A").End(xlUp).Row
target_row = target_wks.Cells(Rows.Count, "A").End _
(xlUp).Row + 1
With source_wks
For row_index = last_row To 1 Step -1
If Application.CountIf(.Rows(row_index), 2) > 1 Then
.Rows(row_index).Copy Destination:= _
target_wks.Rows(target_row)
target_row = target_row + 1
.Rows(row_index).Delete
End If
Next
End With
Application.ScreenUpdating = True
End Sub
 
Top