Moving data from rows to column A

[ExcelSwede]

Hi everyone

This is an easy case. For all except novices like me.

Transform an adress list like this:

To show up in column A like this

I hope someone can build a sub that can do the transformation in a loop until last row.

The purpose is to print adresses from Excel to a sheet of adress-stickers. When data i correct siuted in column A, I think that I can handle the rest.

Thanks for your kindness

ExcelSwede

 

[My Aswer Is This]

You want all the data put in Column A but you do not show where the original data is.

 

[Fluff]

How about

Sub ExcelSwede()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
   
   With Sheets("Sheet1")
      Ary = .Range("A2:C" & .Range("A" & Rows.Count).End(xlUp).Row).Value2
   End With
   ReDim Nary(1 To UBound(Ary) * UBound(Ary, 2), 1 To 1)
   
   For r = 1 To UBound(Ary)
      For c = 1 To UBound(Ary, 2)
         nr = nr + 1
         Nary(nr, 1) = Ary(r, c)
      Next c
   Next r
   Sheets("Sheet2").Range("A1").Resize(nr, 1).Value = Nary
End Sub

Change sheet names & ranges to suit.

 

[ExcelSwede]

How about

Sub ExcelSwede()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
  
   With Sheets("Sheet1")
      Ary = .Range("A2:C" & .Range("A" & Rows.Count).End(xlUp).Row).Value2
   End With
   ReDim Nary(1 To UBound(Ary) * UBound(Ary, 2), 1 To 1)
  
   For r = 1 To UBound(Ary)
      For c = 1 To UBound(Ary, 2)
         nr = nr + 1
         Nary(nr, 1) = Ary(r, c)
      Next c
   Next r
   Sheets("Sheet2").Range("A1").Resize(nr, 1).Value = Nary
End Sub

Change sheet names & ranges to suit.

Thanks Fluff, works perfect.

I tried myself with some clue from exampels in "similar threads" and ended upp with this:

For i = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
Range("A" & i & ":" & "A" & i + 1).Offset(1).EntireRow.Insert
Range("B" & i).Cut Range("A" & i).Offset(1)
Range("C" & i).Cut Range("A" & i).Offset(2)
Next

That sub do the job, even if it take some time while the sheet kan contain 2000 rows. Your sub is much faster and save the original data. My own sub transform original data into a new layout.

 

[Fluff]

You're welcome & thanks for the feedback.