Thursday 25 May 2017

How to copy rows from one excel sheet to another and create duplicates using VBA?



I have excel workbook with two sheets: sheet1 has a large table of data in columns A to R, headers at row 1. Sheet2 has data in columns A to AO.



Using VBA I am trying to copy rows from sheet1 and paste them to the end of sheet2. Also I need to copy only columns A to R, not the entire row.



In other words, cells A2:R2 from sheet1 need to be copied to first AND second row that don't have data in column A.



Any help is highly appreciated!




@AlistairWeir, I have a following code that copies the required cells from sheet1, but I cannot figure out how to copy every row twice.




Sub example()



For Each ce In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)



If Not IsEmpty(ce) Then




Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 18).Value = Range(ce, ce.Offset(0, 17)).Value



End If



Next ce



End Sub



Answer



Try this:




Option Explicit
Sub CopyRows()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim i As Integer, k As Integer
Dim ws1LR As Long, ws2LR As Long

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")


ws1LR = ws1.Range("A" & Rows.Count).End(xlUp).Row + 1
ws2LR = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1

i = 2
k = ws2LR
Do Until i = ws1LR
With ws1
.Range(.Cells(i, 1), .Cells(i, 18)).Copy
End With


With ws2
.Cells(k, 1).PasteSpecial
.Cells(k, 1).Offset(1, 0).PasteSpecial
End With

k = k + 2
i = i + 1
Loop
End Sub



Change Sheet1 and Sheet2 if they are called different things in your workbook.


No comments:

Post a Comment

c++ - Does curly brackets matter for empty constructor?

Those brackets declare an empty, inline constructor. In that case, with them, the constructor does exist, it merely does nothing more than t...