How to copy entire data using row by row and paste to another sheet

0 votes

I'm attempting to transfer my data from one worksheet to another. I want to duplicate the first row on the target sheet, paste it there, then duplicate the second row and paste it there. Actually, I want to duplicate the data in the data sheet row by row, in a loop, till the last row is reached. When the macro reaches the last row and there is no data on it, a pop-up finish message appears.

I've tried the following code, but it doesn't meet my needs. Any advice and assistance would be greatly appreciated.

Sub InsertData()

Dim wsCopy As Worksheet, wsDest As Worksheet
Dim lCopyLastRow As Long, lDestLastRow As Long

'Set variables for copy and destination sheets
Set wsCopy = Workbooks("Warranty Template.xlsm").Worksheets("PivotTable")
Set wsDest = Workbooks("QA Matrix Template.xlsm").Worksheets("Plant Sheet")

'1. Find last used row in the copy range based on data in column A
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, 1).End(xlUp).Row

'2. Find first blank row in the destination range based on data in column A
'Offset property moves down 1 row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, 4).End(xlUp).Offset(1,0).Row

'3. Copy & Paste Data
wsCopy.Range("A5:A" & lCopyLastRow).Copy _
wsDest.Range("D" & lDestLastRow)

End Sub
Feb 5, 2023 in Others by Kithuzzz
• 38,000 points
1,520 views

1 answer to this question.

0 votes

Try this:

Sub InsertData()

    Dim wsCopy As Worksheet, wsDest As Worksheet
    Dim lCopyLastRow As Long, lDestLastRow As Long, row As Long

    'Set variables for copy and destination sheets
    Set wsCopy = Workbooks("Warranty Template.xlsm").Worksheets("PivotTable")
    Set wsDest = Workbooks("QA Matrix Template.xlsm").Worksheets("Plant Sheet")

    '1. Find last used row in the copy range based on data in column A
    lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, 1).End(xlUp).Row

    '2. Find first blank row in the destination range based on data in column A
    'Offset property moves down 1 row
    lDestLastRow = wsDest.Cells(wsDest.Rows.Count,4).End(xlUp).Offset(1,0).Row

    '3. Copy & Paste Data
    For row = 5 To lCopyLastRow ' Cycle form 5th row (as well as you used range from A5) to last filled row (in A column)
        ' First: by copying data (not effective way, your solution is better)
        wsCopy.Range("A" & row).Copy wsDest.Range("D" & (lDestLastRow + (row - 5)))
        
        ' Second: by filling the data
        ' Like this: wsDest.Range("D" & (lDestLastRow + (row - 5))) = wsCopy.Range("A" & row)
    Next row

End Sub
answered Feb 5, 2023 by narikkadan
• 63,600 points

Related Questions In Others

0 votes
0 answers

Data Driven Framework -- how to read and write in excel sheet using Selenium WebDriver with java

I'm using this code to read something, ...READ MORE

Oct 31, 2022 in Others by Kithuzzz
• 38,000 points
650 views
0 votes
1 answer
0 votes
1 answer

Retrieve epay.info Balance with VBA and Excel

This code should log you in, provided ...READ MORE

answered Sep 5, 2018 in Blockchain by digger
• 26,740 points
1,211 views
0 votes
1 answer

How to load file to Excel Power query from SFTP site

Currently, I don't think there is a ...READ MORE

answered Dec 3, 2018 in Power BI by Upasana
• 8,620 points
3,662 views
0 votes
1 answer

Using VBA Excel to create a gramatically correct list

The Excel AND function is a logical ...READ MORE

answered Feb 9, 2022 in Others by gaurav
• 23,260 points
906 views
0 votes
2 answers

How to copy a formula horizontally within a table using Excel VBA?

Hi so basically, create an adjacent column ...READ MORE

answered Feb 16, 2022 in Others by Edureka
• 13,690 points
1,053 views
0 votes
1 answer
0 votes
1 answer

Defining last nine rows of data as range to copy values and transpose paste into another worksheet

Transpose Last Rows Sub PrintLastRowsAddress() ...READ MORE

answered Jan 31, 2023 in Others by narikkadan
• 63,600 points
545 views
webinar REGISTER FOR FREE WEBINAR X
REGISTER NOW
webinar_success Thank you for registering Join Edureka Meetup community for 100+ Free Webinars each month JOIN MEETUP GROUP