VBA Copy Column Between Worksheets Using an End Row

default_name

Board Regular
Joined
May 16, 2018
Messages
180
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
  2. MacOS
Hey guys,

I have three different worksheets.
RawDataA
RawDataB
ReducedData

Basically, I only want to take certain columns of data from each of the RawData sheets and comiple them together in the ReducedRawData worksheet.
With what I currently have, I am running into issues copying over the column down to the end of the row. (I only want to copy over column data down to the end of the raw data [the last row])

Here is what I currently have:
I added comments to hopefully illustrate what I am trying to do

VBA Code:
Sub DataReduce()
  
    EndRow = Sheets("ReducedData").Cells(Rows.Count, 1).End(xlUp).Row + 1
   
   'Brings over RawDataA information from the various columns and pastes it into columns A, B, and C of the ReducedData sheet
    Sheets("RawDataA").Columns("B").Copy Sheets("ReducedData").Range("A1")  'Copies raw data from column B of RawDataA over to column A (starting in A1) of the ReducedData sheet
    Sheets("RawDataA").Columns("J").Copy Sheets("ReducedData").Range("B1")   'Copies raw data from column J of RawDataA over to column B (starting in B1) of the ReducedData sheet
    Sheets("RawDataA").Range("E1" & ":" & "E" & EndRow).Copy   'Copies raw data from column E of RawDataA. I used Range instead of Columns because I couldnt figure out the Special paste with Columns.
    Sheets("ReducedData").Range("C1").PasteSpecial Paste:=xlPasteValues  'Pastes over the Values into column C (starting in C1) of the ReducedData sheet
   
   'Brings over RawDataB information from the various columns and pastes it to the bottom of columns A, B, and C of the ReducedData sheet
    Sheets("RawDataB").Range("U2" & ":" & "U" & EndRow).Copy Sheets("ReducedData").Range("A" & EndRow) 'Copies raw data from column U of RawDataB (all the way to the bottom) over to column A (starting after the data we just pasted above from RawDataA) of the ReducedData sheet
    Sheets("RawDataB").Range("W2" & ":" & "W" & EndRow).Copy Sheets("ReducedData").Range("B" & EndRow) 'Copies raw data from column W of RawDataB (all the way to the bottom) over to column B (starting after the data we just pasted above from RawDataA) of the ReducedData sheet
    Sheets("RawDataB").Range("F2" & ":" & "F" & EndRow).Copy 'Copies raw data from column F of RawDataB (all the way to the bottom).
    Sheets("ReducedData").Range("C" & EndRow).PasteSpecial Paste:=xlPasteValues 'Pastes over the Values into column C (starting after the data we just pasted above from RawDataA) of the ReducedData sheet
   
End Sub

I seem to be having a few issues here.
The EndRow function isnt working as I'd hoped.
I am using two different methods of copying (Columns and Range)...is there another way to accomplish this for consistency?
Really, I'd like all of the copies/pastes to be Values only for formatting sake...but I'm not sure of the proper way to accomplish that.

I hope this makes sense. Thanks in advance for your help and patience!
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
How about this approach

VBA Code:
Sub DataReduce()
  Dim lr1 As Long, lr2 As Long, sh As Worksheet
  Set sh = Sheets("ReducedData")
  With Sheets("RawDataA")
    lr1 = .Range("A" & Rows.Count).End(xlUp).Row
    sh.Range("A1").Resize(lr1).Value = .Range("A1:A" & lr1).Value
    sh.Range("B1").Resize(lr1).Value = .Range("J1:j" & lr1).Value
    sh.Range("C1").Resize(lr1).Value = .Range("E1:E" & lr1).Value
  End With
  
  With Sheets("RawDataB")
    lr1 = .Range("A" & Rows.Count).End(xlUp).Row
    lr2 = sh.Range("A" & Rows.Count).End(xlUp).Row + 1
    sh.Range("A" & lr2).Resize(lr1 - 1).Value = .Range("U2:U" & lr1).Value
    sh.Range("B" & lr2).Resize(lr1 - 1).Value = .Range("W2:W" & lr1).Value
    sh.Range("C" & lr2).Resize(lr1 - 1).Value = .Range("F2:F" & lr1).Value
  End With
End Sub
 
Upvote 0
How about this approach

VBA Code:
Sub DataReduce()
  Dim lr1 As Long, lr2 As Long, sh As Worksheet
  Set sh = Sheets("ReducedData")
  With Sheets("RawDataA")
    lr1 = .Range("A" & Rows.Count).End(xlUp).Row
    sh.Range("A1").Resize(lr1).Value = .Range("A1:A" & lr1).Value
    sh.Range("B1").Resize(lr1).Value = .Range("J1:j" & lr1).Value
    sh.Range("C1").Resize(lr1).Value = .Range("E1:E" & lr1).Value
  End With
 
  With Sheets("RawDataB")
    lr1 = .Range("A" & Rows.Count).End(xlUp).Row
    lr2 = sh.Range("A" & Rows.Count).End(xlUp).Row + 1
    sh.Range("A" & lr2).Resize(lr1 - 1).Value = .Range("U2:U" & lr1).Value
    sh.Range("B" & lr2).Resize(lr1 - 1).Value = .Range("W2:W" & lr1).Value
    sh.Range("C" & lr2).Resize(lr1 - 1).Value = .Range("F2:F" & lr1).Value
  End With
End Sub

This works perfectly!!
Thank you!
 
Upvote 0

Forum statistics

Threads
1,224,822
Messages
6,181,164
Members
453,021
Latest member
Justyna P

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