I need to format data in VBA - vba

Question

I need to format a large set of data across multiple columns.
I have data in sets of 2 columns that need to be formatted into one set of 2 columns, in addition to headers that need to be in cells to the left of the data.
So I need to covert data that is in two columns to:
header1 header2 data1 data2
So the header needs to be copied and pasted all the way down the columns and the multiple columns and headers need to be appended.
This needs to loop across a whole spreadsheet.
Below is my attempt
colA = 5
colB = 3
colC = 2
rowA = 3
rowB = 3
cellA = "C1"
Worksheets("sheet3").Activate
lastA = Cells(Rows.Count, colB).End(xlUp).Row
For x = rowA To lastA
Worksheets("sheet3").Activate
Data = Cells(x, colA)
Worksheets("sheet3").Activate
Cells(rowB, colB) = Data
rowB = rowB + 1
Next x
Do Until colC = 0
Selection.Cut
Cells(1, colB).Select
ActiveSheet.Paste
Range("D1").Select
Selection.AutoFill Destination:=Cells(3, colC)
colC = colB - 1

Answer 1

Different approach.
Read the source data into an array.
Set up a Class consisting of the data for each resultant row
Iterate through the source array, two columns at a time, to construct each row.
Store the RowData into a collection.
When done, transfer the collection into a "results" array.
Write the results array to a Range (I chose to do do this on a different worksheet). Edit the source and destination ranges as required.
First Insert a Class Module; Rename it RowData, and paste the code below:
Option Explicit
Private pHeaderOdd As String
Private pHeaderEven As String
Private pDataOdd As String
Private pDataEven As String
Public Property Get HeaderOdd() As String
HeaderOdd = pHeaderOdd
End Property
Public Property Let HeaderOdd(Value As String)
pHeaderOdd = Value
End Property
Public Property Get HeaderEven() As String
HeaderEven = pHeaderEven
End Property
Public Property Let HeaderEven(Value As String)
pHeaderEven = Value
End Property
Public Property Get DataOdd() As String
DataOdd = pDataOdd
End Property
Public Property Let DataOdd(Value As String)
pDataOdd = Value
End Property
Public Property Get DataEven() As String
DataEven = pDataEven
End Property
Public Property Let DataEven(Value As String)
pDataEven = Value
End Property
Then, in a regular module, paste the following code:
Sub ReFormat()
Dim V As Variant, vRes() As Variant
Dim cRD As RowData
Dim colRD As Collection
Dim I As Long, J As Long
'Get entire source data into array
'May need a different selection method
' depending on your "real" data arrangement
V = Worksheets("Sheet4").Range("a1").CurrentRegion
'initialize collection
Set colRD = New Collection
'get data in pairs and add to collection
For I = 1 To UBound(V, 2) Step 2 'columns
For J = 2 To UBound(V, 1) 'rows
Set cRD = New RowData
cRD.HeaderOdd = V(1, I)
cRD.HeaderEven = V(1, I + 1)
cRD.DataOdd = V(J, I)
cRD.DataEven = V(J, I + 1)
colRD.Add cRD
Next J
Next I
'Put collection into "results" array for writing to the results range
ReDim vRes(1 To colRD.Count, 1 To 4)
For I = 1 To colRD.Count
vRes(I, 1) = colRD(I).HeaderOdd
vRes(I, 2) = colRD(I).HeaderEven
vRes(I, 3) = colRD(I).DataOdd
vRes(I, 4) = colRD(I).DataEven
Next I
Worksheets("Sheet2").Cells.Clear
Worksheets("Sheet2").Range("A1").Resize(UBound(vRes, 1), UBound(vRes, 2)) = vRes
End Sub
Ensure your worksheet and range references are correct, and run the macro.