# Copy Transpose with Macro

#### primala

##### New Member
Hi Guys,

I have data of material installed on each (oil) Well, the number of well is one at the minimum, and up to 60 wells.
Here's the detail :

Column A : sequence number
Column B : item number of material
Column C : description of material
Column D : unit of material
Column E : quantity of material installed of Well # 1
Column F : quantity of material installed of Well # 2
Cell value in E3 (header) : Well # 1
Cell value in F3 (header) : Well # 2

What I want to do :

If I have only 2 wells of material installed (E4 & F4)
Then I should get :
- copy of the first row of material installed (starting from row # 4), from column A to D
into the last row of data, and down 1 row
- copy of the header (Well # 1) in column E
- copy the quantity of Well # 1 (from E4) into column F

- copy of the first row of material installed (starting from row # 4), from column A to D
into the last row of data, and down 1 row
- copy of the header (Well # 2) in column E
- copy the quantity of Well # 2 (from F4) into column F

For more details please find the sample data :

You may found the link below :

I really hope anyone of you could help me out.

### Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
not very good share site, need an account

Hi patel45, which the best one? is it mediafire? or can you recommend the site? thanks

Code:
``````Sub Transpose()
LR = Cells(Rows.Count, "A").End(xlUp).Row
dcol = 11
drow = 4
nw = 5
no = 1
Range("A3:F3").Copy Range("K3")
Range("O3") = "WELL #"
Range("P3") = "QTY"
For j = 4 To LR
For c = 1 To nw
Cells(drow, "K") = no
Cells(drow, "L") = Cells(j, "B")
Cells(drow, "M") = Cells(j, "C")
Cells(drow, "N") = Cells(j, "D")
Cells(drow, "O") = "WELL # " & c
Cells(drow, "P") = Cells(j, 4 + c)
drow = drow + 1
no = no + 1
Next
Next
End Sub``````

Hi patel45,

Thanks for the quick response and the magic code given, the code almost work like I want to do.
The only problem is, if I have more than 5 columns then I have to change, let's say 6 Wells :
Code:
``nw = 6``

I believe the code could identify automatically the number of wells, but I don't know how to modify the code.
I need your magic touch, once again.

Best regards

Is the number of rows fixed to 5 or can change ?
do you prefer have the result in sheet 2 ?

try this
Code:
``````Sub Transpose()
LR = Cells(Rows.Count, "A").End(xlUp).Row
drow = 4
nw = 5 ' <<<< num of wells to be changed
dcol = 6 + nw
no = 1
Range("A3:F3").Copy Cells(3, dcol)
Cells(3, dcol + 4) = "WELL #"
Cells(3, dcol + 5) = "QTY"
For j = 4 To LR
For c = 1 To nw
Cells(drow, dcol) = no
Cells(drow, dcol + 1) = Cells(j, "B")
Cells(drow, dcol + 2) = Cells(j, "C")
Cells(drow, dcol + 3) = Cells(j, "D")
Cells(drow, dcol + 4) = "WELL # " & c
Cells(drow, dcol + 5) = Cells(j, 4 + c)
drow = drow + 1
no = no + 1
Next
Next
End Sub``````

The number of rows could reach 500 (items), while the number of column could reach 60 (wells)
It is okay to copy the result into Sheet 2

Code:
``````Sub Transpose()
Set sh1 = Sheets("DETAIL")
Set sh2 = Sheets(2)
LR = sh1.Cells(Rows.Count, "A").End(xlUp).Row
With sh1
drow = 2
nw = .UsedRange.Columns.Count - 4
dcol = 1
no = 1
.Range("A3:F3").Copy sh2.Cells(drow - 1, dcol)
sh2.Cells(drow - 1, dcol + 4) = "WELL #"
sh2.Cells(drow - 1, dcol + 5) = "QTY"
For j = 4 To LR
For c = 1 To nw
sh2.Cells(drow, dcol) = no
sh2.Cells(drow, dcol + 1) = .Cells(j, "B")
sh2.Cells(drow, dcol + 2) = .Cells(j, "C")
sh2.Cells(drow, dcol + 3) = .Cells(j, "D")
sh2.Cells(drow, dcol + 4) = "WELL # " & c
sh2.Cells(drow, dcol + 5) = .Cells(j, 4 + c)
drow = drow + 1
no = no + 1
Next
Next
End With
End Sub``````

Replies
3
Views
356
Replies
9
Views
203
Replies
2
Views
298
Replies
1
Views
326
Replies
0
Views
142

1,196,429
Messages
6,015,214
Members
441,882
Latest member
rcgyuk

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back