Kopiere rækker der opfylder betingelser via VBA

Er ikke nogen ørn til VBA, men hvis du smed et autofilter på dine data - kunne det måske løse problemet?
Hilsen  Luffe

Prøv med denne:

Sub test()
Dim MitArray, SlutR As Long, SlutC As Long, I As Long, Y As Long, Z As Long, Resultat

Sheets("Ark1").Select

SlutR = Range("A1").SpecialCells(xlLastCell).Row
SlutC = 30
MitArray = Range(Cells(1, 1), Cells(SlutR, SlutC))
ReDim NytArray(0)
For I = 1 To UBound(MitArray)
    If MitArray(I, 1) = 1 Then
        Y = Y + 1
        ReDim Preserve NytArray(Y)
        For Z = 1 To 30
            NytArray(Y) = NytArray(Y) & "|" & MitArray(I, Z)
        Next
    End If
Next

Sheets("Ark2").Select
Dim Resultat
For Y = 1 To UBound(NytArray)
    Resultat = Split(NytArray(Y), "|")
    Sheets("Ark2").Range("A1").Offset(Y - 1).Range(Cells(1, 1), Cells(1, SlutC)) = Resultat
Next
End Sub

Til akyhne:
Skulle lige rette Resultat til noget andet, men du får pointene - tak for hurtig besvarelse :)

Hov - der gav jeg så pointene til mig selv! Er lidt ny herinde... Hvordan får jeg givet dig de 50 point?

Opret et nyt spørgsmål "Point til akyhne" i Excel kategorien, med pointene. Der skal være link til denne http://www.eksperten.dk/spm/796214, så folk kan se hvorfor du giver point til mig.

Spørgsmål er oprettet :)

Svar lagt..