Hjælp til kun at vise besteme data i rækkefølge uden blanke felte

http://home1.stofanet.dk/krogsa/jpeg.JPG  der kom den :D

med makro, hvis det kun er kolonne B,C,D
ellers sig til


Sub Find()
Worksheets("Ark1").Activate
v = InputBox(" indtast søgeværdi", "overfør til nyt ark")
c = 2 ' start rækken
SC = Range("B65536").End(xlUp).Row
For c = 1 To SC
If Cells(c, 3) = v Then
Worksheets("Ark2").Activate
rw = Range("B65536").End(xlUp).Row + 1
Worksheets("Ark1").Activate

Worksheets("Ark1").Range(Cells(c, "B"), Cells(c, "D")).Copy Worksheets("Ark2").Cells(rw, "B")

End If
Next c
End Sub

hvis du skal have kolonne A med også så ret denne linie
Worksheets("Ark1").Range(Cells(c, "B"), Cells(c, "D")).Copy Worksheets("Ark2").Cells(rw, "B")
til
Worksheets("Ark1").Range(Cells(c, "A"), Cells(c, "D")).Copy Worksheets("Ark2").Cells(rw, "A")

Jeg har lavet markoen og prøvet at afspille den så kommer den bare op med at jeg skal intaste værdi. så prøver jeg at skrive eks. rd.. men der skler intet :( står i Ark 2 når jeg afspiller den.. ved ikke om det er korrekt!

er arknavnene korrekte

Ja har kladt dem Ark1 og Ark2 igen nu

den siger "intast søgeværdi"

ja, set skal den også, jeg kunne ikke vide om det var det samme hver gang

ret linien

v = InputBox(" indtast søgeværdi", "overfør til nyt ark")
til

v = "rd"

så spørger den ikke mere

hehe nu er den da stoppet med at sige intast søgeord! men den gør stadigvæk ikke en skid :(

send en demo mappe til mig, så laver jeg det

kabbak snabela tiscali dot dk

oki, hvis du så lige hurtigt skriver hvad det er du gjorde ;D så kan jeg vidst ikke forlange mere ;) og endnu engang tak for dit tidsspild :)

min antivirus fjernede den, siger at der muligvis er virus i ???

kan du ikke smide den ud på den webside du brugte til billedet

hmm tror du ikke det er den makro? kører med norton anti x05 og updateret.. men prøver lige at slette den helt osgå sende igen

tryk på knappen, som jeg satte ind på Ark2

Sub Find()
Application.ScreenUpdating = False
Worksheets("Ark2").Activate
rw = Range("B65536").End(xlUp).Row + 1
Range("A2:d" & rw).ClearContents ' tømmer skrive området inden kørslen
Worksheets("Ark1").Activate
v = "rd"
c = 2 ' start rækken
SC = Range("B65536").End(xlUp).Row
For c = 1 To SC
If Cells(c, 3) = v Then
Worksheets("Ark2").Activate
rw = Range("B65536").End(xlUp).Row + 1
Worksheets("Ark1").Activate
Worksheets("Ark1").Range(Cells(c, "B"), Cells(c, "D")).Copy Worksheets("Ark2").Cells(rw, "B")
End If
Next c
Worksheets("Ark2").Activate
Application.ScreenUpdating = True
End Sub