Have a macro that I need to work on every other column of my worksheet

[Pandrade]

Hi,
I need to make a macro work on every other column of my worksheet. How can I accomplish this. The worksheet has hundreds of columns and I need the macro to work all the way to the last column.

 

[mumps]

You haven't told us what you actually want to do in the columns but this code loops through every second column starting with column 1.

Sub Test()
    Application.ScreenUpdating = False
    Dim x As Long, lCol As Long
    lCol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    For x = 1 To lCol Step 2
        'your code here
    Next x
    Application.ScreenUpdating = True
End Sub

 

[Pandrade]

Thanks, I'll try it and update.

 

[Pandrade]

This is the macro I want to work on every other column. It starts with the N column, so the macro should then work on the P column, and so on every other column to the last of the columns. Can you help?

Sub CopyCells()
Dim Cl As Range
For Each Cl In Range("N2", Range("N" & Rows.Count).End(xlUp))
If Cl.Offset(, 1).Value > 1 Then
Cl.Copy Range("N" & Rows.Count).End(xlUp).Offset(1).Resize(1 * Cl.Offset(, 1) - 1)
End If
Next Cl

End Sub

 

[mumps]

Try:

Sub Test()
    Application.ScreenUpdating = False
    Dim x As Long, LastRow As Long, lCol As Long, Cl As Range
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lCol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    For x = 14 To lCol Step 2
        For Each Cl In Range(Cells(2, x), Cells(LastRow, x))
            If Cl.Offset(, 1).Value > 1 Then
                Cl.Copy Range("N" & Rows.Count).End(xlUp).Offset(1).Resize(1 * Cl.Offset(, 1) - 1)
            End If
        Next Cl
    Next x
    Application.ScreenUpdating = True
End Sub

 

[Pandrade]

It almost works. The macro is copying the values to column N only. I need the Salaries to be copied to the end of each corresponding salary column. For example:
Salary Quantity Salary Quantity Salary Quantity
21000 2 15000 3 36000 1
18000 1 27000 2 48000 4
40000 3 15000 60000 2
21000 15000 48000
40000 27000 48000
40000 48000
60000

 

[Pandrade]

It should look like this:

 

[Fluff]

How about

Sub Pandrade()
   Dim Cl As Range
   Dim UsdCols As Long, i As Long
   
   UsdCols = Cells(1, Columns.Count).End(xlToLeft).Column
   For i = 14 To UsdCols Step 2
      For Each Cl In Range(Cells(2, i), Cells(Rows.Count, i).End(xlUp))
         If Cl.Offset(, 1).Value > 1 Then
            Cl.Copy Cells(Rows.Count, i).End(xlUp).Offset(1).Resize(1 * Cl.Offset(, 1) - 1)
         End If
      Next Cl
   Next i
End Sub

 

[Pandrade]

Thanks, that works!

 

[Fluff]

Glad we could help & thanks for the feedback