Transpose columns to rows from 1 sheet to another sheet with VBA with ongoing columns

[dgirl88]

I have a constantly-updating spreadsheet I use to track projects, but I want to create a summary view for internal stakeholders. I'm looking to transpose my columns to rows from 1 sheet to another sheet. The issue I run into is that as new projects get added on to the original list (as a new column), the transpose stops at the last column I had set it to. It doesn't keep going for the new columns added.
What I have currently (new projects get added to as a new column, so a new project would then go into Column I): https://i.ibb.co/2jpG8Bg/Tasks-Column-Mode.png
What I want is rows 2-10 being transposed to another sheet like this: https://i.ibb.co/SPDx1VM/Tasks-Rows-Mode.png
I was thinking of adding a button and assigning a VBA to it so that everytime you click it, it will update with the new columns and transpose again. But I don't know how to do that. I'm fairly new to VBA so your help is greatly appreciated.

 

[DanteAmor]

Hi @dgirl88, welcome to the forum!

Try this
Change data in red for the names of your sheets.

Sub Transpose_columns_to_rows()
  Dim sh1 As Worksheet, sh2 As Worksheet, lr As Long, j As Long
  Set sh1 = Sheets("[COLOR=#ff0000]Sheet1[/COLOR]")  'origin
  Set sh2 = Sheets("[COLOR=#ff0000]Sheet2[/COLOR]")  'destiny
  sh2.Range("A6", sh2.Cells(Rows.Count, Columns.Count)).ClearContents
  lr = 6
  For j = 3 To sh1.Cells(2, Columns.Count).End(xlToLeft).Column
    sh2.Range("A" & lr).Resize(1, 10).Value = Application.Transpose(sh1.Cells(2, j).Resize(10).Value)
    lr = lr + 1
  Next
End Sub

 

[dgirl88]

Thanks so much! This worked perfectly!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.