Looping down a column and then go to the next colum and loop down it.

[gheyman]

I have code that someone else wrote that I need to modify. It works really well but it runs the code and gathers the data down one column when we need the data from multiple columns. The user has go in and select the next row and run the code each time (over and over for 43 columns). This is also creating a separate tab, with the retrieved data, each time. We dont need separate tabs for each - all the data on one tab is the goal.

Here is the Code: BcurrentCol = StartSheet.Cells(11,1) is identifying which row the user selected. There is a Form the user uses to select the column - that selection gets placed in the (11,1).
We really don't need the user to select a column. We just need it to run through each column (L:BB)
In a perfect world it would skip rows (S:V) but that's easy enough to manually delete from the compiled info.

Sub CreateProPricer()
'Sheets("Resources(Spread Or Load)").Visible = True
 '
    Dim AspecRow
    Dim BcurrentCol
    Dim CtaskCol
    Dim DstartRow

    AspecRow = 4
    CtaskCol = 5
    DstartRow = 9
    
    Dim valueSheet As Worksheet
    Dim ProPSheet As Worksheet
    Dim StartSheet As Worksheet
    
    
    Set ValuesSheet = ThisWorkbook.Sheets("Values")
    Set StartSheet = ThisWorkbook.Sheets("Variables")
    Set ProPSheet = ThisWorkbook.Sheets("Resources (Spread or Load)")
    
    
    BcurrentCol = StartSheet.Cells(11, 1).value
    
    Dim j
    j = DstartRow
                Sheets("Resources (Spread or Load)").Range("A3").Select
    Do While j <= ValuesSheet.Rows.Count
        If hoursGood(j, BcurrentCol) Then
           
     
            Set ProPSheet = ThisWorkbook.Sheets("Resources (Spread or Load)")

            '
            'WBS
            ActiveCell.value = ValuesSheet.Cells(j, 1).value
            'CAT
            ActiveCell.Offset(0, 2).value = ValuesSheet.Cells(AspecRow, BcurrentCol).value
            'Spread Code
            ActiveCell.Offset(0, 6).value = ValuesSheet.Cells(j, 9).value
            'Value
            ActiveCell.Offset(0, 7).value = ValuesSheet.Cells(j, BcurrentCol).value
            'Start
            ActiveCell.Offset(0, 8).value = ValuesSheet.Cells(j, 10).value
            'End
            ActiveCell.Offset(0, 9).value = ValuesSheet.Cells(j, 11).value
            ActiveCell.Offset(1, 0).Activate
            
            
            Application.DisplayAlerts = True
        End If
        
        j = j + 1
    Loop

            Move_PP_Tab
    
End Sub