Simple Copy/Paste VBA is copying the same data multiple times :(

amandabstewart

New Member
Joined
Aug 4, 2014
Messages
45
this works, BUT, when I run the macro again, it copies old data as new at the bottom. it's ok for it to overwright content in A2 on the destination page, but it takes the data like it is new and I get repeat data in the destination table.
any ideas? trying to delete either of the set pastecell parts causes the macro to die :(



Option Explicit

Sub CopyP2()

Dim PatientCol As Range
Dim Patient As Range
Dim PasteCell As Range

Set PatientCol = Sheet1.Range("A2:A99")

For Each Patient In PatientCol


If Sheet4.Range("A2") = "" Then

Set PasteCell = Sheet4.Range("A2")
Else

Set PasteCell = Sheet4.Range("A1").End(xlDown).Offset(1, 0)
End If

If Patient = "P2" Then Patient.EntireRow.Copy PasteCell

Next Patient

End Sub
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Would you just explain what your object is.
Not sure I would write the code this way.
I want to copy the row from one page if the data in the A column (patient) contains "P2" and take that entire copied row to a different page. I've done this in the past with a far more complicated macro--saw this quick one on youtube but it will re-use the old data and paste it as new in the empty rows below the previous one.
 
Upvote 0
You said Page1 I assume you mean Sheet(1)
And copy to sheet(2)
If this is not correct give me both sheet names
 
Upvote 0
Try this:
This script copies entire row to Sheet(2)
If that is not correct change code
Assuming the answers to my question is true:
VBA Code:
Sub Filter_Me_Please()
'Modified  10/6/2021  1:26:28 PM  EDT
Application.ScreenUpdating = False
Dim lastrow As Long
Dim C As Long
Dim s As Variant
C = 1 ' Column Number Modify this to your need
s = "P2" 'Search Value Modify to your need
lastrow = Cells(Rows.Count, C).End(xlUp).Row

With ActiveSheet.Cells(1, C).Resize(lastrow)
    .AutoFilter 1, s
    counter = .Columns(C).SpecialCells(xlCellTypeVisible).Count
    If counter > 1 Then
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets(2).Cells(2, 1)
    Else
        MsgBox "No values found"
    End If
    .AutoFilter
End With
Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,205
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top