Copy Transpose with Macro

primala

New Member
Joined
May 31, 2012
Messages
39
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 :
Screen_Shot.html

Matl Installed - Excel - Download - 4shared
Screen Shot - Download - 4shared


I really hope anyone of you could help me out.
Thanks in advance
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
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
 
Upvote 0
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;)
 
Upvote 0
Is the number of rows fixed to 5 or can change ?
do you prefer have the result in sheet 2 ?
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,550
Messages
6,114,265
Members
448,558
Latest member
aivin

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Back
Top