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

amandabstewart

New Member
Joined
Aug 4, 2014
Messages
40
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

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.

amandabstewart

New Member
Joined
Aug 4, 2014
Messages
40
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.
 

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
18,163
Office Version
  1. 2013
Platform
  1. Windows
You said Page1 I assume you mean Sheet(1)
And copy to sheet(2)
If this is not correct give me both sheet names
 

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
18,163
Office Version
  1. 2013
Platform
  1. Windows
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
 

amandabstewart

New Member
Joined
Aug 4, 2014
Messages
40

ADVERTISEMENT

trying this now...will report back
 

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
18,163
Office Version
  1. 2013
Platform
  1. Windows
See this line of code means Sheet(2) starting in row 2
 

Forum statistics

Threads
1,148,170
Messages
5,745,169
Members
423,930
Latest member
Simple77

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
Top