afmærkning af område mm.

Kan dette være til hjelp?

Sub test()   
    Dim c As Range
    Dim kol As Long
    Dim rad As Long
    Dim lastKol As Long
   
    Range("A1").Select
    kol = 7
    lastKol = Cells(1, Columns.Count).End(xlToLeft).Column
   
    Do
        rad = Cells(Rows.Count, kol).End(xlUp).Row
        For Each c In Range(Cells(1, kol), Cells(rad, kol + 1))
        'her kan du skrive din kode fx
          msgbox c.value         
        Next
        kol = kol + 7
    Loop Until kol + 1 > lastKol
End Sub

hvis det skal være slik at cellene kun skal merkes, kan koden se slik ut

Sub test()
    Dim c As Range
    Dim kol As Long
    Dim rad As Long
    Dim lastKol As Long
    Dim UnionRange As Range
 
    Range("A1").Select
    kol = 7
    lastKol = Cells(1, Columns.Count).End(xlToLeft).Column
    Do
        rad = Cells(Rows.Count, kol).End(xlUp).Row
        If kol = 7 Then
            Set UnionRange = Range(Cells(1, kol), Cells(rad, kol + 1))
        Else
        Set UnionRange = Union(UnionRange, Range(Cells(1, kol), Cells(rad, kol + 1)))
        End If         
       
        kol = kol + 7
    Loop Until kol + 1 > lastKol
    UnionRange.Select
End Sub

Endnu et bud - måske skal der justereslidt i forhold til 7 til højre:

Dim maxRække, maxKolonne, r, aktuelleKol, ss As String
Sub activeworkbook_activate()
Dim mR As Range

    Cells(1, 1).Select
    maxKolonne = ActiveCell.SpecialCells(xlCellTypeLastCell).Column
    maxRække = ActiveCell.SpecialCells(xlCellTypeLastCell).Row
    aktuelleKol = 1
    ss = ""
   
    While aktuelleKol + 7 <= maxKolonne - 1
        aktuelleKol = aktuelleKol + 7
        Cells(1, aktuelleKol).Select
        beh_Kolonne (0)
        beh_Kolonne (1)
    Wend
   
    ss = Mid(ss, 1, Len(ss) - 1)
    Set mR = Range(ss)
    mR.Select
End Sub
Private Sub beh_Kolonne(offset)
    For r = 2 To maxRække + 1
        If Cells(r, aktuelleKol + offset) = "" Then
            ss = ss + Chr(64 + aktuelleKol + offset) + "1:" + Chr(64 + aktuelleKol + offset) + CStr(r - 1) + ","
            Exit For
        End If
    Next r
End Sub

Hej supertekst
det ser ud til at at private sub beh_kolonne(offset) ikke virker. den tager ikke maxrække med ind i rutinen. Hvordan virker linien: maxrække? jeg havde en forventning om, at den virkede på den kolonne, hvor cursoren er aktiv i det øjeblik linien afvikles, men tilsyneladende anderledes. Den første procedure virker helt som ønsket.

Hej Hubertus

Maxrække er global defineret og tilskrives værdi når workbook aktiveres. Maxrække er nr på den sidste række i hele arket, der er udfyldt.

Prøv evt. at sende en prøve på hvordan dit ark ser ud til: pb@supertekst-it.dk

hej supertekst  send et svar, så du kan få dine point (tak for hjælpen)

Selv tak - her er et svar!