point til mrjh

Hej igen

Gider du bruge lidt tid på at skrive for hver linie hvad det er jeg i det hele taget gør ;O)


Sub Test()

Dim a, b, c, d, i, tæl, tæl1, tæl2, indsat

Application.ScreenUpdating = False
Sheets("opstart skiver").UsedRange.ClearContents
Sheets("sorteret opstart skiver").UsedRange.ClearContents
Workbooks.Open Filename:= _
"h:\Nye skiver\2006\opstart_skiver_checkliste test.xls"
Sheets("Checkliste").Range("a4:aa900").Copy _
Destination:=Workbooks("makro april").Sheets("opstart skiver").Range("a2")
Workbooks("opstart_skiver_checkliste test").Close savechanges:=False

For Each a In Sheets("opstart skiver").Range("a2:a900")
tæl = 0
tæl1 = 0
    For Each b In Sheets("opstart skiver").Range("a2:a" & a.Row)
        If a = b And b <> "" Then
        tæl = tæl + 1
        If a.Offset(, 1) = b.Offset(, 1) Then
        tæl1 = tæl1 + 1
        End If
        End If
    Next
   
    If tæl = 1 Then
    Range("a2").Offset(i, 0) = a
    Range("c2").Offset(i, 0) = a.Offset(, 10)
    i = i + 1
    tæl2 = 0
    indsat = ""
    End If
   
    If tæl1 = 1 Then
    tæl2 = tæl2 + 1
    If tæl2 <= 3 Then
    indsat = indsat & a.Offset(, 1) & "/"
    Range("b2").Offset(i - 1, 0) = indsat
    End If
    End If
Next

For Each txt In Range("b2:b900")
    If txt <> "" Then
    txt1 = Left(txt, Len(txt) - 1)
    Range("b2").Offset(j, 0) = txt1
    j = j + 1
    End If
Next

Rows("1:900").AutoFit
Columns("a:iv").AutoFit
Application.ScreenUpdating = True




End Sub



Mvh
LN