Paste data. Is there a quicker way?

[amitvnarendra]

Hello,

I have an excel file where the top row consists of dates (182 data points) and then I have column A which consists of city names (90 city names).

Now I want to transpose dates in column and then I want to paste cities next to the dates. Eg: so for the 182 dates data point I want to paste city A next to all the data points. Then I want to paste again those 182 data point and next to it paste city B, and so on until I paste all the 90 cities.
Is there a quick way of performing this task?

Any help on this will be highly appreciated.

Kind regards,

Amit Narendra

 

[Kaper]

This task is called unpivoting.
Nowadays probably the easiest way to do is to use Power Query (it's available since Excel 2010 as an add-in and since 2016 it is an integral part of the excel itself).
many materials were published on how to use it. The first (not necesserily the best) I can see after writing "unpivot power query" in search engine is: How To Unpivot Data With Power Query | How To Excel

 

[MaxD]

If Power Query isn't something you're comfortable with yet & assuming I've understood the request, this code works too.

Sub TransposeData()

Application.ScreenUpdating = False

Dim i As Integer
Dim finalRow, finalCol As Long
Dim ColLetter As String

'Check if Output sheet exists for transposed data
For i = 1 To Worksheets.Count
    If Worksheets(i).Name = "Output" Then
        exists = True
    End If
Next i
    
If Not exists Then
    Sheets.Add(After:=Sheets("Sheet1")).Name = "Output"
End If

Sheets("Sheet1").Select

finalRow = Range("A" & Rows.Count).End(xlUp).Row
finalCol = ActiveSheet.Range("A1").CurrentRegion.Columns.Count

'Convert final column Number to Letter
ColLetter = Split(Cells(1, finalCol).Address, "$")(1)

'Transpose Dates
Range("B1:" & ColLetter & "1").Select
Selection.Copy
Sheets("Output").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    
'Transpose Citites
Sheets("Sheet1").Select
finalRow = Range("A" & Rows.Count).End(xlUp).Row
Range("A2:A" & finalRow).Select
Selection.Copy

Sheets("Output").Select
finalRow = Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To finalRow
    Range("B" & i).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Next i

Range("A1").Select
    
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub