Excel VBA: Loop af kolonner

Hejsa,

Har du mulighed for at sende arket eller lidt af det til mig, så skal jeg gerne kigge på det?

Med venlig hilsen

Henrik

Som aftalt kommer her et svar og løsningen blev som vist herunder.

Option Explicit
Sub Job_skema()
   
    Dim Navn As String      'Ansøgers navn
   
    Dim ARK1 As String      'Ansøgerark
    Dim Ark2 As String      'opslåede stillinger
   
    Dim aRK As Long        'Rækkevariabel Ansøgerark
    Dim aKO As Long        'Kolonnevariabel Ansøgerark
    Dim AnSt_nr As String  'Stillingsnr Ansøgerark
   
    Dim oKO As Long        'Kolonnevariabel opslåede stillinger
    Dim oRK As Long        'Rækkevariabel opslåede stillinger
    Dim ST_nr As String    'Stillingsnr Opslåede stillinger

    Dim Status As String    'Ansøger eller Besat (Ansøgere_afdelingsopdeles)
    Dim Ma_nr As String
    Dim WRX As String
    Dim Nu_afd As String
    Dim Nu_stil As String
    Dim F_stil As String
    Dim Til_stil As String
    Dim Eft_stil As String
    Dim stil_sog As String
    Dim Ans_modt As String
    Dim Stil_nr As String
    Dim Stil_navn As String
   
    ARK1 = "Ansøgere_afdelingsopdeles"
    Ark2 = "Oversigt_opslåede_stillingsnr"
   
    oKO = 3
    aRK = 4
    oRK = 3
    oKO = 3
    Do
    Sheets(ARK1).Select
    Cells(aRK, 10).Select
    Selection.End(xlToRight).Select
    aKO = ActiveCell.Column
    If Cells(3, aKO) = "Ansøger" Then
    Cells(aRK, 10).Select
    aRK = aRK + 1
    Else
    aKO = aKO - 1
    Stil_nr = Cells(1, aKO)
    Stil_navn = Cells(2, aKO)
    Navn = Cells(aRK, 1)
    Ma_nr = Cells(aRK, 2)
    WRX = Cells(aRK, 3)
    Nu_afd = Cells(aRK, 4)
    Nu_stil = Cells(aRK, 5)
    F_stil = Cells(aRK, 6)
    Til_stil = Cells(aRK, 7)
    Eft_stil = Cells(aRK, 8)
    stil_sog = Cells(aRK, 9)
    Ans_modt = Cells(aRK, 10)

    Sheets(Ark2).Select
    Cells(1, 1).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    oRK = ActiveCell.Row
    Cells(oRK, 1) = Stil_nr
    Cells(oRK, 3) = Stil_navn
   
    Cells(oRK, 4) = Navn
    Cells(oRK, 5) = Nu_afd
    aRK = aRK + 1
    End If

    Sheets(ARK1).Select
    Loop Until Cells(aRK, 1) = ""
    Cells(4, 1).Select
   
    Sheets(Ark2).Select
    Cells(2, 1).Select
    Range("A2:F500").Sort Key1:=Range("A2"),    Order1:=xlAscending, Header:= _
        xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
   
    oRK = 3
    Do
    Cells(oRK, 2).Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(VLOOKUP(RC[-1],Stillingstyper!R2C1:R10C2,2,FALSE)),""Stillingsnr findes ikke!"",VLOOKUP(RC[-1],Stillingstyper!    R2C1:R10C2,2,FALSE))"
    oRK = oRK + 1
    Loop Until Cells(oRK, 1) = ""
    Cells(3, 1).Select
   
End Sub