Kód: Vybrat vše
Option Explicit
Sub SWNutnaLicence()
Dim Sht As Worksheet, SBlok As Range, SCll As Range
Dim TSht As Worksheet, TBlok As Range, TCll As Range, TNew As Range, i As Long
i = 0
Set TSht = Worksheets("licence")
Set TBlok = TSht.UsedRange
TBlok.Offset(1, 0).ClearContents
Set TNew = TSht.Range("a2")
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "Licence" Then
Set SBlok = Range(Sht.Range("A24"), Sht.Range("A24").End(xlDown))
For Each SCll In SBlok
If SCll.Offset(0, 3).Value = "Nutna licence" Then
Set TBlok = Range(TSht.Range("A2"), TSht.Range("A2").End(xlDown))
With TBlok
Set TCll = .Find(SCll.Value, LookIn:=xlValues)
If Not TCll Is Nothing Then
TCll.Offset(0, 1).Value = TCll.Offset(0, 1).Value + 1
Else
TNew.Offset(i, 0).Value = SCll.Value
TNew.Offset(i, 1).Value = 1
i = i + 1
End If
End With
End If
Next SCll
End If
Next Sht
End Sub
Kód: Vybrat vše
Option Explicit
Sub SWNutnaLicence()
Dim Sht As Worksheet, SBlok As Range, SCll As Range
Dim TSht As Worksheet, TBlok As Range, TCll As Range, TNew As Range, i As Long
i = 0
Set TSht = Worksheets("licence")
Set TBlok = TSht.UsedRange
TBlok.Offset(1, 0).ClearContents
Set TNew = TSht.Range("a2")
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "Licence" Then
Set SBlok = Range(Sht.Range("A24"), Sht.Range("A24").End(xlDown))
For Each SCll In SBlok
If SCll.Offset(0, 3).Value = "Nutna licence" Then
Set TBlok = Range(TSht.Range("A2"), TSht.Range("A2").End(xlDown))
With TBlok
Set TCll = .Find(Trim(SCll.Value), LookIn:=xlValues, LookAt:=xlWhole)
If Not TCll Is Nothing Then
TCll.Offset(0, 1).Value = TCll.Offset(0, 1).Value + 1
Else
TNew.Offset(i, 0).Value = Trim(SCll.Value)
TNew.Offset(i, 1).Value = 1
i = i + 1
End If
End With
End If
Next SCll
End If
Next Sht
Set TBlok = Range(TSht.Range("A2"), TSht.Range("B2").End(xlDown))
TBlok.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub