How to copy and paste multiple column data from one sheet to another sheet using vba

Question

I'm very new to VBA and I have been trying to develop a tool to merge two sheets with only selected columns of data to output sheet.

I have two sheets with name RCV and MGT. Both have a unique column where it should be matched and paste it on the 3rd sheet which has the name Output.

I tried moving from one cell to another but as the data size too large it takes too long time as the iteration for checking each cell is too high.

The RCV sheet has around 35000 rows of data and MGT sheet has around 25000 rows of data.

Sub Merge_Data()
Dim i, j
Dim k
Dim WS1 As Worksheet
Set WS1 = ThisWorkbook.Sheets("RCV")
Dim WS2 As Worksheet
Set WS2 = ThisWorkbook.Sheets("MGT")
Dim files As Variant
Dim LRow1 As Long
LRow1 = WS1.Range("A" & WS1.Rows.Count).End(xlUp).Row
Dim LRow2 As Long
LRow2 = WS2.Range("A" & WS2.Rows.Count).End(xlUp).Row
k = 3
For i = 2 To LRow1
For j = 2 To LRow2

If Sheets("RCV").Cells(i, "Q").Value = Sheets("RCV").Cells(j, "AD").Value 
Then

Sheets("Output").Cells(k, "F").Value = Sheets("RCV").Cells(i, "Q").Value
Sheets("Output").Cells(k, "H").Value = Sheets("RCV").Cells(i, "R").Value
Sheets("Output").Cells(k, "A").Value = Sheets("MGT").Cells(j, "V").Value

k = k + 1
End If
Next
Next
End Sub

Please do help me how to solve this issue. I need to copy multiple columns from RCV sheet and MGT sheet when the condition matches (Column Range from Q2 to Lastrow = AD2 to Lastrow).

The output sheet after merging columns from RCV sheet and MGT sheet:

Answer 1

since you have far less then 60k row or so, you could exploit AutoFilter() method of Range object with xlFilterValues operator, allowing you to filter on more values:

Option Explicit

Sub Merge_Data()
    Dim sheet1Data As Variant

    With Worksheets("MGT") '<--| reference your worksheet "MGT"
        sheet1Data = Application.Transpose(.Range("AD2", .Cells(.Rows.Count, "AD").End(xlUp)).Value) '<--| fill an array with referenced sheet column AD values from row 2 down to last not empty one
    End With
    With Worksheets("RCV") '<--| reference your worksheet "RCV"
        With .Range("Q1", .Cells(.Rows.Count, "Q").End(xlUp)) '<--| reference referenced sheet column Q cells from row 1 (header) down to last not empty one
            .AutoFilter Field:=1, Criteria1:=sheet1Data, Operator:=xlFilterValues '<--| filter refrenced cells with sheet 2 column A values
            If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then ' if any match
                Dim cell As Range, k As Long
                k = 3
                For Each cell In .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible) ' loop through referenced range filtered cells (skipping header)
                    Worksheets("Output").Cells(k, "F").Value = Worksheets("RCV").Cells(cell.Row, "Q").Value
                    Worksheets("Output").Cells(k, "H").Value = Worksheets("RCV").Cells(cell.Row, "R").Value
                    Worksheets("Output").Cells(k, "A").Value = Worksheets("MGT").Cells(Application.Match(cell.Value2, sheet1Data, 0) + 1, "V").Value
                    k = k + 1
                Next
            End If
        End With
        .AutoFilterMode = False
    End With
End Sub

Answer 2

This will go through each row in WS1 and copy each cell in the row to WS2 in a new line. Some syntax might be wrong because I didn't test it or write in in my excel vba editor. But this is my solution.

dim lastrow1 as long
dim lastrow2 as long
dim i as long
dim j as long
lastrow1 = Application.CountA(WS1.Range("A:A"))
lastrow2 = Application.CountA(WS2.Range("A:A"))

Application.ScreenUpdating = False 'not necessary but this will speed things up 

for i = 1 to lastrow1
   lastCol1 = WS1.Cells(i, Columns.Count).End(xlToLeft).Column
   'counting used columns in each row

   lastrow2 = lastrow2 + 1 'starting a new row in WS2
       for j = 1 to lastCol1
           WS2.Cells(lastrow2,j).Value = WS1.Cells(i,j).Value

       next j
next i

Application.ScreenUpdating = True 'in pair with screenupdating=false

"Could you let me know how could I copy selected column cells from Sheet 1 (RCV) and Sheet 2 (MGT) together to Sheet 3 (Output) when Column Cell values (Q - RCV) and Column cell values (AD - MGT) matches ? "

This could be a heavy way. But you could make it faster when you get more familiar with vba. Or someone else would give a lighter way later.

 'i is for WS1's rows and j is for WS2's now. col is for column count in a specific line.
dim col as long
dim rowWS3 as long
Set WS3 = ActiveWorkbook.Sheets("output")

for i = 1 to lastrow1
   for j = 1 to lastrow2
      if WS1.Cells(i,17) = WS2.Cells(j,30) 'you may add the .Value if needed
        'Q is the 17th column and Ad is the 30th. I am not sure I counted it right.

         lastCol1 = WS1.Cells(i, Columns.Count).End(xlToLeft).Column
         lastCol2 = WS2.Cells(j, Columns.Count).End(xlToLeft).Column
         rowWS3 = rowWS3 + 1
         for col = 1 to lastCol1
              WS3.Cells(rowWS3, col) = WS1.Cells(i,col)
         next col

         rowWS3 = rowWS3 + 1
        for col = 1 to lastCol2
              WS3.Cells(rowWS3, col) = WS2.Cells(j,col)
         next col
     end if
   next j
next i