prasz
New Member
- Joined
- Sep 12, 2022
- Messages
- 4
- Office Version
- 365
- 2021
- 2019
- 2016
- Platform
- Windows
- MacOS
Sub AddSheets()
Application.ScreenUpdating = False
Dim rng As Range, v As Variant, i As Long, srcWS As Worksheet
Set srcWS = Sheets("cikk20220908")
v = srcWS.Range("D2", srcWS.Range("D" & Rows.Count).End(xlUp)).Value
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(v, 1)
If Not .Exists(v(i, 1)) Then
.Add v(i, 1), Nothing
With srcWS
.Range("A1").CurrentRegion.AutoFilter 4, v(i, 1)
If Not Evaluate("isref('" & v(i, 1) & "'!A1)") Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = v(i, 1)
.AutoFilter.Range.Copy Range("A1")
End If
End With
End If
Next i
End With
srcWS.Range("A1").AutoFilter
Application.ScreenUpdating = True
End Sub
=FILTER(cikk20220908!A1:E7,cikk20220908!D1:D7="EGYA")
Excellent, thank you very mutchTry:
VBA Code:Sub AddSheets() Application.ScreenUpdating = False Dim rng As Range, v As Variant, i As Long, srcWS As Worksheet Set srcWS = Sheets("cikk20220908") v = srcWS.Range("D2", srcWS.Range("D" & Rows.Count).End(xlUp)).Value With CreateObject("Scripting.Dictionary") For i = 1 To UBound(v, 1) If Not .Exists(v(i, 1)) Then .Add v(i, 1), Nothing With srcWS .Range("A1").CurrentRegion.AutoFilter 4, v(i, 1) If Not Evaluate("isref('" & v(i, 1) & "'!A1)") Then Sheets.Add(After:=Sheets(Sheets.Count)).Name = v(i, 1) .AutoFilter.Range.Copy Range("A1") End If End With End If Next i End With srcWS.Range("A1").AutoFilter Application.ScreenUpdating = True End Sub