Help copying data and transpose from one sheet to new sheet

TxRob81

New Member
Joined
Nov 12, 2019
Messages
1
I have an issue. I told my wife I could write a script for this. Well its a bit out of my range. I thought it was easy but its not for me because I dont do this enough.

I have a spreadsheet and lets say I need to copy A2, D2, and E2 to another sheet 20 times but I also need to transpose the headings from columns CK1:DD1 into Column D, and then Transpose CK2:DD2 into column E. This is the data set (20).

Then I need to loop for each row this until the end of the list for lets say column D.

CK1:DD1 will always be the same 20 for each row that is copied.

Can anyone help? I know its a loop and transposing but not sure how to go about it.
Final result would look like this for each row from original sheet into final.
Data1Data2Data3Data4Data5
A2D2E2CK1CK2
A2D2E2CL1CL2
A2D2E2CM1CM2
A2D2E2CN1CN2
A2D2E2CO1CO2
A2D2E2CP1CP2
A2D2E2CQ1CQ2
A2D2E2CR1CR2
A2D2E2CS1CS2
A2D2E2CT1CT2
A2D2E2CU1CU2
A2D2E2CV1CV2
A2D2E2CW1CW2
A2D2E2CX1CX2
A2D2E2CY1CY2
A2D2E2CZ1CZ2
A2D2E2DA1DA1
A2D2E2DB1DB2
A2D2E2DC1DC2
A2D2E2DD1DD2

<tbody>
</tbody>
 

Some videos you may like

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.

Leith Ross

Well-known Member
Joined
Mar 17, 2008
Messages
1,874
Office Version
  1. 2010
  2. 2007
Platform
  1. Windows
Hello TxRob81,

Here is VBA macro do what you asked. Change the worksheet names in the macro code to match the names you are using. The variable name WksSrc refers to the Source Worksheet and WksDst refers to the Destination Worksheet.

Code:
Sub CopyAndTranspose()


    Dim Data    As Variant
    Dim RngDst  As Range
    Dim WksDst  As Worksheet
    Dim WksSrc  As Worksheet
    
        Set WksSrc = ThisWorkbook.Worksheets("Sheet1")
        Set WksDst = ThisWorkbook.Worksheets("Sheet2")
    
        Data = Array(WksSrc.Range("A2"), WksSrc.Range("D2"), WksSrc.Range("E2"))
        
        Set RngDst = WksDst.Range("A2:C2")
            RngDst.Resize(20, 3).Value = Data
            
        Data = Application.Transpose(WksSrc.Range("CK1:DD1"))
        WksDst.Range("D2").Resize(20, 1).Value = Data


        Data = Application.Transpose(WksSrc.Range("CK2:DD2"))
        WksDst.Range("E2").Resize(20, 1).Value = Data
            
End Sub

This code needs to be a VBA Module.



  • Copy the macro above with Ctrl+C.
  • Open the workbook and use Alt+F11 to open the VB Editor.
  • Use ALT+I to display the Insert Menu.
  • Press the M key to add a new Module.
  • Paste the macro into the Module with Ctrl+V.
  • Save the macro using Ctrl+S



You can then run the macro using the Macro Dialog. Press ALT and F8 together to display it. Click on CopyAndTranspose in the list then click RUN.
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
48,400
Office Version
  1. 365
Platform
  1. Windows
Welcome to the MrExcel board!

Then I need to loop for each row this until the end of the list for lets say column D.
This is my take on what you require. Check sheet names in the code & I have assumed that the 2nd sheet already exists but has no data (at least in columns A:E)

Test in a copy of your workbook.

Rich (BB code):
Sub Testing()
  Dim ADE As Variant, CKDD As Variant
  Dim i As Long
  
  With Sheets("Sheet1")
    CKDD = Application.Transpose(.Range("CK1:DD2").Value)
    ADE = Application.Index(.Cells, Evaluate("row(2:" & .Range("D" & .Rows.Count).End(xlUp).Row & ")"), Array(1, 4, 5))
  End With
  With Sheets("Sheet2")
    For i = 1 To UBound(ADE)
      .Range("A" & .Rows.Count).End(xlUp).Offset(1).Resize(20, 3).Value = Application.Index(ADE, i, 0)
      .Range("D" & Rows.Count).End(xlUp).Offset(1).Resize(20, 2).Value = CKDD
    Next i
  End With
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,128,132
Messages
5,628,892
Members
416,352
Latest member
Lunox01

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
Top