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>
 

Leith Ross

Well-known Member
Joined
Mar 17, 2008
Messages
1,852
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
41,683
Office Version
365
Platform
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
 

Forum statistics

Threads
1,077,662
Messages
5,335,561
Members
399,024
Latest member
rokcel389

Some videos you may like

This Week's Hot Topics

Top