Difficult macro - table data

[Timbo6]

I am trying to take a table of data, that varies in number of columns and rows, and create a table of data.

The Cust No / Name / Curr are always fixed in number of columns.
Wk1 etc can extend to an unknown number of columns

The rows in terms of number of rows are variable

DATA
Cust No. Name Curr Wk1 Wk2 Wk3 Wk4
133 Cust 1 EUR 1.00 23.00 0.00 26.00
143 Cust 2 GBP 0.00 12.00 1.00 13.00
etc

RESULT REQUIRED

Cust No. Name Curr Week Value
133 Cust 1 EUR Wk1 1.00
133 Cust 1 EUR Wk2 23.00
133 Cust 1 EUR Wk3 0.00
133 Cust 1 EUR Wk4 26.00
143 Cust 2 GBP Wk1 0.00
143 Cust 2 GBP Wk2 12.00
143 Cust 2 GBP Wk3 1.00
143 Cust 2 GBP Wk4 13.00

 

[al_b_cnu]

Hi, Welcome to the board!

Try this:

Sub XXX()
Dim iCol As Integer
Dim lRow As Long
Dim R As Range
Dim vData(1 To 5) As Variant
Dim wsFr As Worksheet, wsTo As Worksheet

Set wsFr = Sheets("Sheet1")
Set wsTo = Sheets("Sheet2")

wsTo.Cells.ClearContents
vData(1) = "Cust No"
vData(2) = "Name"
vData(3) = "Curr"
vData(4) = "Week"
vData(5) = "Value"
wsTo.Range("A1:E1").Value = vData

lRow = 1
For Each R In wsFr.Range("A2:A" & wsFr.Cells(Rows.Count, "A").End(xlUp).Row)
    For iCol = 1 To 3
        vData(iCol) = R.Offset(0, iCol - 1).Value
    Next iCol
    For iCol = 1 To 4
        vData(4) = wsFr.Cells(1, iCol + 3).Value
        vData(5) = R.Offset(0, iCol + 2).Value
        lRow = lRow + 1
        wsTo.Range("A" & lRow & ":E" & lRow).Value = vData
    Next iCol
Next R
End Sub

To install, [Alt-F11], Insert / Module & paste above into code window

 

[Timbo6]

One variable is not working

Thanks.

Rows
The macro works as far as the rows are concerned. It writes data for each
row and stops at the last row.

Columns
This does not work completely.
The number of weeks (columns past the first three, Cust No, Name , Curr) is variable, sometimes whole year, half year etc

The macro at present writes the first four weeks for each row. What is the variable that works out how many weeks columns there are ?

Regards

 

[al_b_cnu]

Sub XXX()
Dim iCol As Integer
Dim lRow As Long, lRowCur As Long
Dim R As Range
Dim vData(1 To 5) As Variant
Dim wsFr As Worksheet, wsTo As Worksheet

Set wsFr = Sheets("Sheet1")
Set wsTo = Sheets("Sheet2")

wsTo.Cells.ClearContents
vData(1) = "Cust No"
vData(2) = "Name"
vData(3) = "Curr"
vData(4) = "Week"
vData(5) = "Value"
wsTo.Range("A1:E1").Value = vData

lRow = 1
For Each R In wsFr.Range("A2:A" & wsFr.Cells(Rows.Count, "A").End(xlUp).Row)
    For iCol = 1 To 3
        vData(iCol) = R.Offset(0, iCol - 1).Value
    Next iCol
    lRowCur = R.Row
    For iCol = 4 To wsFr.Cells(lRowCur, Columns.Count).End(xlToLeft).Column
        vData(4) = wsFr.Cells(1, iCol).Value
        vData(5) = wsFr.Cells(lRowCur, iCol).Value
        lRow = lRow + 1
        wsTo.Range("A" & lRow & ":E" & lRow).Value = vData
    Next iCol
Next R
End Sub

 

[Timbo6]

Many Thanks

Excellent.

Many Thanks