Copy data from sheet1 to sheet2

Closed
jangir72 Posts 2 Registration date Monday December 30, 2013 Status Member Last seen January 9, 2014 - Jan 8, 2014 at 06:43 AM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Jan 9, 2014 at 01:18 AM
Hello,

I want to copy data from sheet 1 to sheet 2. I have data in 4 columns and 100 row in sheet1. I want to copy each row of sheet 1 in sheet 2 in 2 rows until no empty row in sheet1, 1st row same as in sheet1 and next row by inter changing col a with col b as follows:
Sheet 1 row 1 is heading (Name1, Name 2, Qty., Amount)
Sheet 1 row 2 (Cell a2 = Zahara, Cell b2 = Mohammed, Cell c2 = 25, Cell d2 = 1000
I want to copy this row in sheet 2 as follows:
sheet 2 row2 - (Cell a2 = Zahara, Cell b2 = Mohammed, Cell c2 = 25, Cell d2 = 1000
sheet 2 row3 - (Cell a2 = Mohammed, Cell b2 = Zahara, Cell c2 = 25, Cell d2 = 1000
Next row sheet 1
Can anybody help me to write this macro?

Related:

3 responses

jangir72 Posts 2 Registration date Monday December 30, 2013 Status Member Last seen January 9, 2014
Jan 9, 2014 at 12:47 AM
Thank you so much Venkat. Can you make some changes:
1. when I run macro, heading in sheet 2 is deleted while I want to keep 1 row as heading without changes.
2. if I want to add 2 more columns "E" and "F" and want copy same as col A and col B
For example
Sheet 1,Row 2 - Cell E2 = Ram and Cell F2 = 50
I want to copy in sheet 2
Row 2 - Cell E2 = Ram and Cell F2 = 50
Row 3 - Cell E3 = 50 Cell F3 = Ram

Thanks & regards
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811
Jan 9, 2014 at 01:18 AM
posts a small extract of sheet1 and sheet 2 in one workbook through "speedyshare.com"
and explain agaiin. You have to give the speedyshre url where the file is uploaded.
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811
Jan 9, 2014 at 12:16 AM
try this macro (no blank rows or columns in sheet1)

Sub test()
Dim j As Integer, k As Integer, r As Range
Worksheets("sheet2").Cells.Clear
With Worksheets("sheet1")
For j = 2 To .Range("a1").End(xlDown).Row
k = .Range("a1").End(xlToRight).Column
Set r = Worksheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
Range(.Cells(j, 1), .Cells(j, "D")).Copy Range(r, r.Offset(1, 0))

Next j
End With
With Worksheets("sheet2")
For j = 2 To Range("A2").End(xlDown).Row
If j Mod 2 = 1 Then
Cells(j, 1) = Cells(j - 1, 2)
Cells(j, 2) = Cells(j - 1, 1)
End If
Next j

End With