Avatar billede Sus Novice
05. april 2018 - 13:34 Der er 5 kommentarer og
1 løsning

Kopier rækker markeret med x til nyt ark - Evt. Makro

Hej
Jeg bruger Excel 2016. Tænker at mit problem skal løses vha. makro og da jeg ikke skarp i makrokodningen har jeg brug for lidt hjælp.
Jeg har flere ark - ark 1- ark 2 - ark 3 og ark Tilbud. Alle ark er identiske mht. kolonner. Der er mange rækker i hhv. ark 1-3 - de rækker der markeres i kolonne E med et "x" ønsker jeg kopieret til arket Tilbud, alt hvad der står på rækken skal kopieres over. Hvis det ikke er muligt at makroen søger i flere ark efter rækker der er markeret med et "x" kan de godt samles på 1 ark.
Mine kolonner betegnes som følgende:
Kolonne A - Nr 
Kolonne B - Beskriv
Kolonne C - liste 1
Kolonne D - liste 2
Kolonne E - overfør
Håber der er nogen der kan hjælpe.
05. april 2018 - 13:39 #1
Har du en kolonne, hvor der ikke er tomme celler?
05. april 2018 - 13:45 #2
Et skud fra hoften

Sub kopiMedX()
    Dim wks As Worksheet
    Dim c As Range
    For Each wks In Worksheets
        If LCase(wks.Name) <> "tilbud" Then
            For Each c In Range(wks.Range("A1"), wks.Range("A1").End(xlDown)).Cells
                If LCase(c.Offset(0, 4).Value) = "x" Then
                    c.EntireRow.Copy Destination:=Worksheets("Tilbud").Range("A" & Worksheets("Tilbud").Rows.Count).End(xlUp)
                End If
            Next
        End If
    Next
End Sub


Forudsætter at du ikke har tomme celler i kolonne A.
Undersøger alle arkfaner undtagen det, der hedder "Tilbud"
Avatar billede Sus Novice
05. april 2018 - 14:17 #3
Som en test satte jeg kryds i 5 rækker jeg ønskede overført men den viser kun den sidste af rækkerne. Umiddelbart tror jeg at makroen mangler at gå til næste tomme række i Tilbuds fanen for at indsætte den næste række. Ellers ser det super ud.
05. april 2018 - 14:20 #4
Sorry - der manglede lige et offset


Sub kopiMedX()
    Dim wks As Worksheet
    Dim c As Range
    For Each wks In Worksheets
        If LCase(wks.Name) <> "tilbud" Then
            For Each c In Range(wks.Range("A1"), wks.Range("A1").End(xlDown)).Cells
                If LCase(c.Offset(0, 4).Value) = "x" Then
                    c.EntireRow.Copy Destination:=Worksheets("Tilbud").Range("A" & Worksheets("Tilbud").Rows.Count).End(xlUp).Offset(1,0)
                End If
            Next
        End If
    Next
End Sub
Avatar billede Sus Novice
05. april 2018 - 14:23 #5
lille tilføjelse - A vil altid være udfyldt :)
Avatar billede Sus Novice
05. april 2018 - 14:25 #6
Hold da op hvor er du fantastisk - Det virker helt perfekt. Tusind tak for din hjælp.
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
Stort udvalg af Excel kurser til alle niveauer og jobfunktioner

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





White paper
Sådan: Opgradér din printerløsning uden store investeringer