VBA Copy 2 cells every n-th column and transpose ?

[vadius]

Hi there

I am trying to develop a code that select two cells (one name + one number) in one sheet (SMI_Ranking) and transpose them in a new sheet (Final_ranking). The cells I want to copy are every 4th column

From
name1/nb1...[4columns]...name2/nb2 ....[4columns].... name3/nb3

to
name1/nb1
name2/nb2
name3/nb3

Below is the code I tried to do but it is not working.

Has anyone an idea ?

Thanks!

Sub Finalranking()
Dim a, j As Integer
Dim table As Variant
'select the 2 cells every two 4 columns
For j = 5 To 121 Step 4
table(1, j) = Worksheets("SMI_Ranking").Range(Cells(1, j - 1), Cells(1, j))
'put the result in the "ranking" sheet
Worksheets.Add().Name = "Final_ranking"
Worksheets("Final_ranking").Activate
a = 1
Cells(1, a).Value = table(1, j)
a = a + 1

Next j
End Sub

 

[Comfy]

Is the name and number to be transposed from two cells into one or into two cells?

 

[vadius]

Hi

it is transpose to two separate cells

cell(A1) & Cell (B1) ...[4 column]....cell(G1) & Cell (H1)


to
cell(A1) & Cell (B1)cell(G1) & Cell (H1)

thanks

 

[Comfy]

Try this:

Sub Finalranking()
Dim a, j As Integer
Dim table(1 To 29, 1 To 2) As Variant
a = 5
For j = 1 To 29
table(j, 1) = Worksheets("Sheet1").Cells(1, a).Value
table(j, 2) = Worksheets("Sheet1").Cells(1, a + 1).Value
a = a + 4
Next j
'put the result in the "ranking" sheet
Worksheets.Add().Name = "Final_ranking"
Worksheets("Final_ranking").Activate
For j = LBound(table) To UBound(table)
Cells(j, 1).Value = table(j, 1)
Cells(j, 2).Value = table(j, 2)
Next j
End Sub

To calculate the table size I took the numbers from your original post:

(121 - 5)/4 = 29

This might be wrong but you can change it

 

[vadius]

it's nearly great

below exactly what I was looking for

Thanks for your help !

Sub Finalranking()
Dim a, j As Integer
Dim table(1 To 29, 1 To 2) As Variant
a = 4
For j = 1 To 29
table(j, 1) = Worksheets("SMI_Ranking").Cells(1, a).Value
table(j, 2) = Worksheets("SMI_Ranking").Cells(1, a + 1).Value
a = a + 4
Next j
'put the result in the "ranking" sheet
Worksheets.Add().Name = "Final_ranking"
Worksheets("Final_ranking").Activate
For j = LBound(table) To UBound(table)
Cells(j, 2).Value = table(j, 2)
Cells(j, 1).Value = table(j, 1)
Next j
End Sub