Avatar billede timtoftgaard Praktikant
17. december 2005 - 20:01 Der er 6 kommentarer og
1 løsning

flytning af rækker til andet ark ud fra kriterier i det første ar

I et ark har jeg 10 kolonner med felter, hvor der er tekstfelter, talfelter og datoerfelter. Der er i alt 50 rækker
Jeg skal nu flytte nogle af rækkerne til et nyt ark. Det skal gøres for de rækker, hvor der i kolonne D (tekstfelt) står enten TTJ eller KSP.
Der skal kun flyttes disse rækker, som indeholder TTJ eller KSP, og de stå øverst oppe, som de øverste rækker i det nye ark.
Avatar billede brynil Nybegynder
17. december 2005 - 20:54 #1
Du kan forsøge med denne:

Dim i, o As Integer

o = 1
Sheets("Ark1").Select

For i = 50 To 1 Step -1
    Cells(i, 4).Select
    If ActiveCell.Value = "TTJ" Or ActiveCell.Value = "KSP" Then
        Range(i & ":" & i).Select
        Selection.Cut
        Sheets("Ark2").Select
        Cells(o, 1).Select
        ActiveSheet.Paste
        o = o + 1
        Sheets("Ark1").Select
        Selection.Delete Shift:=xlUp
    End If
Next i
Avatar billede brynil Nybegynder
17. december 2005 - 21:14 #2
Pastet i modsat rækkefølge:

Dim i, o, p, c As Integer

Sheets("Ark1").Select

For p = 1 To 50
    If UCase(Cells(p, 4).Value) = "TTJ" Or UCase(Cells(p, 4).Value) = "KSP" Then
        c = c + 1
    End If
Next p

o = 1

For i = 50 To 1 Step -1
    Cells(i, 4).Select
    If UCase(ActiveCell.Value) = "TTJ" Or UCase(ActiveCell.Value) = "KSP" Then
        Range(i & ":" & i).Select
        Selection.Cut
        Sheets("Ark2").Select
        Cells(c, 1).Select
        ActiveSheet.Paste
        c = c - 1
        o = o + 1
        Sheets("Ark1").Select
        Selection.Delete Shift:=xlUp
    End If
Next i
Avatar billede timtoftgaard Praktikant
17. december 2005 - 21:22 #3
prøvet begge men lidt problem. Jeg tror nummer to er bedst men den skal kopiere rækkerne og ikke flytte dem. DE forsvinder fra det første ark
Tim
Avatar billede timtoftgaard Praktikant
17. december 2005 - 21:25 #4
jeg har rettet lidt, så den passer til min ark
Sub ryg()
Dim i, o, p, c As Integer

Sheets("Sheet1").Select

For p = 3 To 64
    If UCase(Cells(p, 17).Value) = "TTJ" Or UCase(Cells(p, 17).Value) = "KPS" Then
        c = c + 1
    End If
Next p

o = 1

For i = 50 To 1 Step -1
    Cells(i, 17).Select
    If UCase(ActiveCell.Value) = "TTJ" Or UCase(ActiveCell.Value) = "KPS" Then
        Range(i & ":" & i).Select
        Selection.Cut
        Sheets("Rygpatienter").Select
        Cells(c, 1).Select
        ActiveSheet.Paste
        c = c - 1
        o = o + 1
        Sheets("Sheet1").Select
        Selection.Delete Shift:=xlUp
    End If
Next i
End Sub
Avatar billede brynil Nybegynder
17. december 2005 - 21:41 #5
Så er der ingen grund til at loope baglæns eller tælle antal forekomster:

Dim i, c As Integer
c = 1

Sheets("Ark1").Select

For i = 3 To 64
    If UCase(Cells(i, 4).Value) = "TTJ" Or UCase(Cells(i, 4).Value) = "KSP" Then
        Range(i & ":" & i).Copy
        Sheets("Ark2").Select
        Cells(c, 1).Select
        ActiveSheet.Paste
        c = c + 1
        Sheets("Ark1").Select
        Application.CutCopyMode = False
    End If
Next i
Avatar billede timtoftgaard Praktikant
17. december 2005 - 21:49 #6
Ja nu virker den uden problemer.

Mange tak for din endnu engang - smukt arbejde

Send et svar!!

mvh
Tim
Avatar billede brynil Nybegynder
17. december 2005 - 21:50 #7
Kommer hér ;)) Takker!
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester