Avatar billede Brus Juniormester
19. december 2022 - 10:25 Der er 3 kommentarer og
3 løsninger

Macro til at kopier linjer baseret på hvad der står i en kolonne.

Hej alle sammen.

Først et link til nogle billeder af mit Excel: https://flic.kr/s/aHBqjAjKVF
Jeg har fjernet nogle få linjer og streget lidt over, da det er fortroligt.

Sidder og prøver at lave en Marco, der skal finde alle de steder i kolonne J (biled 1), der bliver "Pakket". Heraf skal jeg så kopier hele denne linje (Hvor der står pakket i slutningen) ind i et andet ark. (biled 2), den kopieret linje skal altid bare tilføjes under næste ledig række.

Marcon skal køre ved brug af en "Knap" jeg selv opretter.

Håber VIRKELIG nogle kan hjælpe mig!
Avatar billede jens48 Ekspert
19. december 2022 - 21:57 #1
Mon ikke noget i denne retning kan bruges? Højreklik på Pakkelistens faneblad og læg det ind under koder

Sub flyt()
Dim LastRow, Rk, x As Long
LastRow = Worksheets("Pakket Oversigt").UsedRange.Rows.Count
Rk = Worksheets("Pakkelisten").UsedRange.Rows.Count
For x = 2 To Rk
If Cells(x, 10) = "Pakket" Then
Rows(x).EntireRow.Copy Destination:=Worksheets("Pakket oversigt").Cells(LastRow + 1, 1)
LastRow = LastRow + 1
End If
Next
End Sub
Avatar billede Brus Juniormester
03. januar 2023 - 08:36 #2
Hej Jens, den fungere tildeles.

Den tager dog ikke dem der er pakket. Men kun dem som ikke står der. Se vedhæftet billeder. Den tager dog samme antal som der står "Pakket" ved. Du kan se de to billeder i sharepointet. Heraf kan du sammenligne de 2 ordre nr. med hinanden.

https://stansomatic-my.sharepoint.com/:f:/g/personal/cba_stansomatic_dk/Eu9-JrUGiEZOnIL9-Zrpkd4BNiVNmQ8UsxTOOiR6kZKK1A?e=dVwahC
Avatar billede jens48 Ekspert
10. januar 2023 - 13:38 #3
Jeg har rettet lidt i makroen, så den først sletter den oprindelige liste, før den laver en ny. Håber det er nok til at fjerne den fejl du har - og som jeg i øvrigt ikke kan se hvordan er opstået, da du har oploaded billeder i stedet for selve excelarket

Sub flyt()
Dim LastRow, Rk, x As Long
Worksheets("Pakket Oversigt").Range("A3:J1000").ClearContents
LastRow = 2
Rk = Worksheets("Pakkelisten").UsedRange.Rows.Count
For x = 3 To Rk
If Cells(x, 10) = "Pakket" Then
Rows(x).EntireRow.Copy Destination:=Worksheets("Pakket oversigt").Cells(LastRow + 1, 1)
LastRow = LastRow + 1
End If
Next
End Sub
Avatar billede jens48 Ekspert
11. januar 2023 - 08:50 #4
Problemet var at makroen kopierer formler i stedet for værdier. Denne makro skulle kunne klare det:

Sub flyt()
Dim LastRow, Rk, x As Long
Worksheets("Pakket Oversigt").Range("A3:J1000").ClearContents
LastRow = 2
Rk = Worksheets("Pakkelisten").UsedRange.Rows.Count
For x = 3 To Rk
If Worksheets("Pakkelisten").Cells(x, 10) = "Pakket" Then
Worksheets("Pakkelisten").Range(Cells(x, 1), Cells(x, 10)).Copy
Worksheets("Pakket Oversigt").Cells(LastRow + 1, 1).PasteSpecial xlPasteValues
LastRow = LastRow + 1
End If
Next
End Sub
Avatar billede jens48 Ekspert
11. januar 2023 - 13:39 #5
Og hvis du vil have den til at slette linjerne på "Pakkelisten" efter flytning, kan du bruge:

Sub flyt()
Dim LastRow, Rk, x As Long
LastRow = Worksheets("Pakket Oversigt").UsedRange.Rows.Count
Rk = Worksheets("Pakkelisten").UsedRange.Rows.Count
For x = Rk To 3 Step -1
If Worksheets("Pakkelisten").Cells(x, 10) = "Pakket" Then
Worksheets("Pakkelisten").Range(Cells(x, 1), Cells(x, 10)).Copy
Worksheets("Pakket Oversigt").Cells(LastRow + 1, 1).PasteSpecial xlPasteValues
Worksheets("Pakkelisten").Cells(x, 1).EntireRow.Delete
LastRow = LastRow + 1
End If
Next
End Sub
Avatar billede Brus Juniormester
11. januar 2023 - 16:02 #6
Sub flyt()
Dim LastRow, Rk, x As Long
'Worksheets("Pakket Oversigt").Range("A3:J1000").ClearContents
LastRow = Worksheets("Pakket Oversigt").UsedRange.Rows.Count
Rk = Worksheets("Pakkelisten").UsedRange.Rows.Count
For x = Rk To 3 Step -1
If Worksheets("Pakkelisten").Cells(x, 10) = "Pakket" Then
Worksheets("Pakkelisten").Range(Cells(x, 1), Cells(x, 10)).Copy
Worksheets("Pakket Oversigt").Cells(LastRow + 1, 1).PasteSpecial xlPasteValues
LastRow = LastRow + 1
End If
Next
Worksheets("Pakkelisten").Range("J3:J100").ClearContents
End Sub
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