Help with moving data to archivec data sheet

fish0321

New Member
Joined
Sep 15, 2020
Messages
2
Office Version
  1. 2016
Hi all,

First, thanks for the help, I really appreciate all you EXCEL pros for taking the time to help us Noobs. I have is pieced together a bit of code to move data from one sheet to another when a certain condition is met. I have two sheets in the same workbook, one TEST sheet and one ARC DATA sheet. The code i used moves data from the TEST sheet to the ARC DATA sheet when a "Y" is present in a specified column (column P) and I press a button. The problem I am having is that when the data is copied over to the ARC DATA sheet it also copies any formulas I have in the cells. Also, i don't know if this modified formula is the most efficient coding for the job. any help would be great, i have included an example workbook.


I would like to move just the cell data and not any codes within the cells.


Here is a copy of the current code I am using for the command button to move data:

Private Sub CommandButton1_Click()
Dim r As Long, lr As Long
r = 2
lr = Cells(Rows.Count, 1).End(xlUp).Row
Do Until r = lr + 20
If Cells(r, 16) = "y" Then
Range(Cells(r, 1), Cells(r, 11)).Copy
Worksheets("ARC DATA").Select
erow = Worksheets("ARC DATA").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

ActiveSheet.Paste Destination:=Worksheets("ARC DATA").Rows(erow)
End If
r = r + 1
 

Some videos you may like

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off

fadee2

Active Member
Joined
Nov 7, 2020
Messages
336
Office Version
  1. 2019
Platform
  1. Windows
How about

VBA Code:
erow = Worksheets("ARC DATA").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

Cells(erow, 1).PasteSpecial Paste:=xlPasteValues


This will only paste values after last row of ARC Data sheet.
 

vcoolio

Well-known Member
Joined
Jun 29, 2014
Messages
1,056
Hello Fish0321,

Here's another option using AutoFilter which is a quicker, more efficient method especially if your data set is large.

VBA Code:
Option Explicit

Private Sub CommandButton1_Click()

        Dim wsT As Worksheet: Set wsT = Sheets("TEST")
        Dim wsAD As Worksheet: Set wsAD = Sheets("ARC DATA")
        
Application.ScreenUpdating = False

        With wsT.[A1].CurrentRegion
                .AutoFilter 16, "Y"
                .Columns("A:K").Offset(1).Copy
                wsAD.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues
                .AutoFilter
        End With
        
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

I'm assuming:-

- Your data starts in Row2 with headings in Row1.
- You only need data from Columns A:K transferred to the ARC DATA sheet.

Do you intend to keep all the data in the TEST sheet or should any row of transferred data be deleted from the TEST sheet?

I hope that this helps.

Cheerio,
vcoolio.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,529
Messages
5,625,351
Members
416,096
Latest member
forevans

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