copy values from from Sheet1 and Sheet2 paste in Upload sheet

Question

I have values in Sheet1 and sheet2 in columns A, B , C , D and E. Also,these values are some vlookup values from other sheets. Now how should I write code to copy these values(only) from sheet1 and sheet2 and paste in Upload sheet.

NOTE: column Value in Sheet1 and sheet2 ,

• ** A** to be copied in D of Upload,
• B to be copied in F column of Upload,
• C to be copied in C column of Upload,
• D to be copied in E of Upload

And everytime the number of coulmns to be copied will be different. So when sheet1 is copied to Upload, it has to find the next avaliable row and start coping valus from sheet2 into it.

Private Sub CommandButton1_Click() Dim firstrowDB1 As Long, lastrow1 As 
Long Dim lastcol As Long, firstrowDB As Long Dim arr1, arr2, i, 
firstRowCount As Integer firstrowDB1 = 1
arr1 = Array("A", "B", "C", "D")
arr2 = Array("D", "F", "C", "E")
For i = LBound(arr1) To UBound(arr1)
    Sheets("Sheet1").Columns(arr1(i)).Copy

    Sheets("upload").Columns(arr2(i)).PasteSpecial xlPasteValues
Next
Application.CutCopyMode = False

The above code works good for copying sheet1 to Upload in the specific columns but I don't how should I finext next blank cell in Upload sheet and start copying and pasting the values from Sheet 2.

Help Needed please!

Answer 1

This looks like a lot, but since you are switching the columns around, many iterations of copy/paste are needed. You could also ranges equal to one another and save time, but I did not do that here.

Notice you need to recalculate the last row on Upload once you have finished pasting your values from Sheet 1 . Instead of recalculating LRow3 you could just do some math. The second calculation of LRow3 will also be equal to the initial value of LRow3 + LRow1 - 1 .

Toggled off screen updating for performance boost

---

Option Explicit

Sub Parsley()

Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet2")
Dim Upl As Worksheet: Set Upl = ThisWorkbook.Sheets("Upload")

Dim LRow1 As Long, LRow2 As Long, LRow3 As Long

LRow1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
LRow2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row
LRow3 = Upl.Range("A" & Upl.Rows.Count).End(xlUp).Offset(1).Row

Application.ScreenUpdating = False
    ws1.Range("A2:A" & LRow1).Copy: Upl.Range("D" & LRow3).PasteSpecial xlPasteValues
    ws1.Range("B2:B" & LRow1).Copy: Upl.Range("F" & LRow3).PasteSpecial xlPasteValues
    ws1.Range("C2:C" & LRow1).Copy: Upl.Range("C" & LRow3).PasteSpecial xlPasteValues
    ws1.Range("D2:D" & LRow1).Copy: Upl.Range("E" & LRow3).PasteSpecial xlPasteValues

    LRow3 = Upl.Range("A" & Upl.Rows.Count).End(xlUp).Offset(1).Row

    ws2.Range("A2:A" & LRow2).Copy: Upl.Range("D" & LRow3).PasteSpecial xlPasteValues
    ws2.Range("B2:B" & LRow2).Copy: Upl.Range("F" & LRow3).PasteSpecial xlPasteValues
    ws2.Range("C2:C" & LRow2).Copy: Upl.Range("C" & LRow3).PasteSpecial xlPasteValues
    ws2.Range("D2:D" & LRow2).Copy: Upl.Range("E" & LRow3).PasteSpecial xlPasteValues
Application.ScreenUpdating = True

End Sub

Answer 2

I tried to take a stab using your method. I used column index numbers in the array rather letter
( A = 1 , B = 2 , C = 3 , etc. )

It's shorter, but a lot more complicated to follow. This will always use Column A as the indicator of where the last row is (from bottom up rather top down). Not Tested

---

Option Explicit

Sub Parsley()

Dim CopyArr: CopyArr = Array(1, 2, 3, 4)
Dim PasteArr: PasteArr = Array(4, 6, 3, 5)
Dim ws: ws = Array("Sheet1", "Sheet2")

Dim ws3 As Worksheet: Set ws3 = ThisWorkbook.Sheets("Upload")

Dim i As Integer, j As Integer, LRow As Long, uLRow As Long

Application.ScreenUpdating = False
    For i = LBound(ws) To UBound(ws)
        Set ws = Sheets(ws(i))
        LRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
        uLRow = ws3.Range("A" & ws3.Rows.Count).End(xlUp).Offset(1).Row
            For j = LBound(CopyArr) To UBound(CopyArr)
                ws.Range(ws.Cells(2, CopyArr(j)), ws.Cells(LRow, CopyArr(j))).Copy
                ws3.Cells(uLRow, PasteArr(j)).End(xlUp).Offset(1).PasteSpecial xlPasteValues
            Next j
    Next i
Application.ScreenUpdating = True

End Sub