Der afhængig af min afgænsninger kan være på 1-1000 linie
Jeg skal hente det der står fra kolonne C6(ark1) og ned Over i i andet ark Fra B9(ark2) men kun en gang selv om det står flere steder arktet fra c6 B9 hop hop hop rul hop stå rul ---> rul hip stå
fra hver gang der laves en ny afgrændsning er der nye data fra B9 og ned som skal over i c6 og ned
Er det noget man kan og nogen der har noget kode de kan låne mig ;O))
Sub Flyt() Dim LastRow, x, y As Long y = 9 LastRow = Range("C:C").SpecialCells(xlCellTypeLastCell).Row For x = 6 To LastRow If Application.WorksheetFunction.CountIf(Worksheets("Ark2").Range("B:B"), Cells(x, 3)) = 0 Then Cells(x, 3).Copy Destination:=Worksheets("Ark2").Cells(y, 2) y = y + 1 End If Next End Sub
Jeg har rettet makroen, så den starter med at slette det der står i Ark2 Kolonne B og indsat en instruktion for at stoppe mellemregningerne. Det skulle gøre den meget hurtigere.
Sub Flyt() Dim LastRow, x, y As Long Application.Calculation = xlManual Worksheets("Ark2").Range("B9:B1000").ClearContents y = 9 LastRow = Range("C:C").SpecialCells(xlCellTypeLastCell).Row For x = 6 To LastRow If Application.WorksheetFunction.CountIf(Worksheets("Ark2").Range("B:B"), Cells(x, 3)) = 0 Then Cells(x, 3).Copy Destination:=Worksheets("Ark2").Cells(y, 2) y = y + 1 End If Next Application.Calculation = xlAutomatic End Sub
Sub Flyt() Dim LastRow, x, y As Long Dim z As String Application.Calculation = xlManual Worksheets("Ark2").Range("B9:B1000").ClearContents y = 9 LastRow = Range("C:C").SpecialCells(xlCellTypeLastCell).Row For x = 6 To LastRow - 1 z = Left(Cells(x, 3), 30) If Application.WorksheetFunction.CountIf(Worksheets("Ark2").Range("B:B"), z) = 0 Then Worksheets("Ark2").Cells(y, 2) = z y = y + 1 End If Next Application.Calculation = xlAutomatic End Sub
Synes godt om
Ny brugerNybegynder
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.