To stebou souhlasím. "Ať se trochu potrápí"
Bohužel mi to nejde setřídit podle pomocného sloupce, zkoušel jsem to přes autofiltr kde jsem
1) byl schopen na všech listech setřídit shodná a neshodná jména, ale nebyl jsem schopen nějak smazat ty nechtěné řádky
2) a ještě jsem pak ztroskotal na tom když jsem přidal nějaká data do sloupce B pak se to filtrovalo prvním filtrem a nebyl jsem schopen to filtrovat až tím třetím.
Kód: Vybrat vše
With Wsht
With .Range("C6")
.Value = "duplikace"
End With
For Each Cll In Blk.Cells
With Cll
.AutoFilter Field:=1, Criteria1:="~*N~*"
End With
Next Cll
End With
Asi jdu na to nějak špatně
Edit 19:00Ještě se my podařilo udělat toto, ale to my jde jinak v krokování a jinak v auto.
Kód: Vybrat vše
Sub DelRows()
'
Dim Wsht As Worksheet, Blk As Range, Cll As Range
Dim Podminka As Variant, Ofs As Long
' pro vsechny listy
For Each Wsht In ThisWorkbook.Worksheets
' mimo listy kterých se to netýká
If Wsht.Name <> "prehled" Then
' zjisteni duplicity jmen na dvou listech pro vymaz
[color=#FF8000]With Wsht[/color]
' definovat blok vyhledavani
Set Blk = Wsht.Range("C7:C19")
'smaz radky dle podminky
For Each Cll In Blk.Cells
[color=#FF8000]With Cll[/color]
Podminka = "*" 'Znak podle ktereho se mazou radky
Ofs = Blk.Rows.Count - 1
Set Blk = Blk.Resize(1, 1)
Do ' odstraneni radku'
If Blk.Offset(Ofs, 0).Value = Podminka Then Blk.Offset(Ofs, 0).EntireRow.Delete
Ofs = Ofs - 1
Loop While Ofs > -1
Range("A1").Select
End With
Next Cll
End With
End If
Next
'
End Sub
Jeto sice krkolomné, ale mám to.
![Very Happy :D](./images/smilies/icon_biggrin.gif)