Programmera Macro Excel - Find All och inte bara Find

Hej Sweclockers!

Sitter just nu och håller på och skapa ett Macro som ska hitta alla rader som innehåller *PERSON och sedan markera dessa för att sedan flytta dem till ett nytt sheet.

Jag lyckas lösa så att allt fungerar som det ska förutom att den inte kan hitta ALLA som innehåller *PERSON utan den tar endast första alternativet den hittar och flyttar över det...

Det som används är denna rad:

Cells.Find(What:="*PERSON", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate

Är inte jätte duktig på Macros så om det går att skriva om denna simpla rad så att den inte bara tar ett value utan tar alla value skulle jag uppskatta detta enormt!

Dim i, j As Long
For i = 1 To Worksheets("Blad1").Range("A1").SpecialCells(xlCellTypeLastCell).Row
    If (Worksheets("Blad1").Range("A" & i).Value Like "*person*") Then
        j = j + 1
        Worksheets("Blad2").Range("A" & j).Value = Worksheets("Blad1").Range("A" & i).Value
        End If
Next

Tack för svar!

Nu är ju jag som sagt inte absolut världsbäst på excel och makros någonstans, men denna kod måste man specificera vilka celler den ska kopiera va? första och sista?

Glömde nämna i första sidan att detta Macro ska fungera för flera olika filer där det är olika mängd rader och man ska slippa skapa ett nytt makro för varje fil. Därför jag försökt *PERSON då alla fält som innehåller det ska flyttas till en egensida, kan variera på vilka celler denna data ligger i nämligen och därför kan jag inte använda en funktion där man måste specificera celler...

Tack för svar i alla fall! Rätta mig gärna om jag förstått fel med att man måste ange celler där

Hej!

Har gjort om lite så nu fungerar det att använda din kod där, tack så mycket!
Bara en liten fråga..

Jag skulle vilja att varje rad den kopierar data från raderas efter varje steg men just nu lyckas den bara med att göra detta för varannan rad och även bara varannan rad flyttas över... verkar som den plusar +2 eller något vet ej.. skulle du kunna se om det är något fel på denna kod...?

   Dim i, j As Long
For i = 1 To Worksheets("Rights").Range("A1").SpecialCells(xlCellTypeLastCell).Row
    If (Worksheets("Rights").Range("A" & i).Value Like "*PERSON*") Then
        j = j + 1
        Worksheets("Userlist").Range("A" & j).Value = Worksheets("Rights").Range("A" & i).Value
        Worksheets("Rights").Range("A" & i).Delete Shift:=xlUp
        End If
Next

För just nu flyttar den bara över hälften av datan som borde flyttas, tar jag bort den sista raden med Delete Shift så blir det perfekt men då är datan och cellerna kvar på första bladet fortfrande.. Vet du något bra sätt att lösa detta?

Dim i, j As Long
For i = 1 To Worksheets("Rights").Range("A1").SpecialCells(xlCellTypeLastCell).Row
    If (Worksheets("Rights").Range("A" & i).Value Like "*PERSON*") Then
        j = j + 1
        Worksheets("Userlist").Range("A" & j).Value = Worksheets("Rights").Range("A" & i).Value
        Worksheets("Rights").Range("A" & i).Delete
        i = i - 1
    End If
Next

Funkar perfekt, tack så jätte mycket!!

Hej igen!

Har lite nya problem med samma kod som jag hoppas du kanske skulle kunna hjälpa mig med, eller någon annan förstås också!

Nu är det så att jag har vissa fält i column B som innehåller formler (använt VLOOKUP) men vissa av dessa fält kommer bli #N/A och då skulle jag vilja få koden att leta igenom dessa rader efter dessa #N/A och tömma innehållet i cellerna men denna kod fungerar inte just nu för det... Förstår att jag skrivit ngt fel så skulle vara väldigt tacksam om du skulle kunna veta vad som ska ändras för att den ska radera innehållet i de celler som har en formel men

Dim h As Long
For h = 1 To Worksheets("Rights").Range("B1").SpecialCells(xlCellTypeLastCell).Row
    If (Worksheets("Rights").Range("A" & h).Value Like "*#N/A*") Then
        Worksheets("Rights").Range("A" & h).ClearContents
        h = h - 1
        End If
Next