Kopiere rækker ud fra værdier

Forslag:

Dim Ark_1, Ark_2, SumRæk, BeløbRæk
Sub kopierRækker()
Rem Koden indlægges i Ark1
    Application.ScreenUpdating = False
   
    Set Ark_1 = ActiveWorkbook.Sheets(1)
    Set Ark_2 = ActiveWorkbook.Sheets(2)
    SumRæk = 5
    BeløbRæk = 4
   
    testDataFraArk1
   
    Ark_2.Activate
    Ark_2.Columns.AutoFit
   
    Application.ScreenUpdating = True
   
    MsgBox ("Kopiering er udført")
End Sub
Private Sub testDataFraArk1()
    Ark_1.Activate
    sidsterække = ActiveCell.SpecialCells(xlLastCell).Row
   
Rem Test om kolonne A begynder med "sum"
    For ræk = 1 To sidsterække
        celleA = LCase(Ark_1.Cells(ræk, 1))
        If Left(celleA, 3) = "sum" Then
            kopierTilArk2 ræk, SumRæk
            SumRæk = SumRæk + 2
        End If
       
Rem test om beløb i kolonne G
        celleG = Ark_1.Cells(ræk, 7)
        If IsNumeric(celleG) = True And celleG <> "" Then
            kopierTilArk2 ræk, BeløbRæk
            BeløbRæk = BeløbRæk + 2
        End If
    Next ræk
End Sub
Private Sub kopierTilArk2(fraRæk, tilRæk)
    Ark_1.Rows(fraRæk).Select
    Selection.Copy
   
    Ark_2.Activate
    Ark_2.Rows(tilRæk).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
   
    Ark_1.Activate
End Sub

Har desværre ikke haft tid til at teste endnu.

Jeg har dog en rettelse :-)

Ark2 er det primære regneark, dvs. ark1 slettes efterbrug.

I ark2/fane1 hvor rækker skal hentes, indeholder kolonne G et beløb, rækken skal så kopieres over i ark2/fane2 i lige rækker startende med A4.

sum-rækkerne i ark1 ser alle sådan ud (mængde for hver type):
Kolonne A (type),B,C,D,E,F,G (mængder)
Sum 1000 019100, 1.224, 335, 306, 170, 432, 0
Sum 1000 019125, 192, 254, 857, 132, 55, 0
Sum 1000 025100, 501, 615, 301, 52, 70, 5
Sum 1085 0251501, 1.283, 2.788, 146, 979, 734, 410
o.s.v.

Efter en oprydningkørsel ser rækkerne i ark2 sådan ud (beløb for hver type pr. lgd.):
Kolonne A (type), B (længde), D, E (beløb)
1000 019100, 60, 19 X 100 FYR U/S, 7,22, 18,05
flere længder
1000 019100, 630, 19 X 100 FYR U/S, 7,22, 18,05
1000 019125, 60, 19 X 125 FYR U/S, 9,03, 22,56
flere længder
1000 019125, 630, 19 X 125 FYR U/S, 9,03, 22,56
1000 019150, 60, 19 X 150 FYR U/S, 10,40, 21,95
o.s.v.
1085 0251501, 390, 25 X 150 FYR SEXTA STERN TRYK., 9,53, 23,81
1085 0251501, 420, 25 X 150 FYR SEXTA STERN TRYK., 10,58, 23,81
o.s.v.

Som du ser, kan beløbet i kolonne G være forskelligt ved samme type og det skulle gerne være en række for hver type med beløb samt en række for hver type med mængder.

Resultatet i ark2/fane2 skulle gerne ende i følgende (optimalt):
Ellers hver dim. Fordelt på 2 rækker.
Kolonne A,B,C,D,E,F,G, H, I, J
1000 019100, 19 X 100 FYR U/S, , , , , , , 7,22, 18,05
sum 1000 019100, , 1.224, 335, 306, 170, 432, 0, ,
1085 0251501, 25 X 150 FYR SEXTA STERN TRYK., , , , , , , 9,53, 23,81
1085 0251501, 25 X 150 FYR SEXTA STERN TRYK., , , , , , , 10,58, 23,81
sum 1085 0251501, , 1.283, 2.788, 146, 979, 734, 410
o.s.v.

Håber det er forståeligt.
Sender gerne ark, hvis det vil hjælpe på situationen.

Du må gerne sende den pågældende fil til: pb@supertekst-it.dk
PS: Når du skriver Ark2/fane2 - hvad mener du så med "fane" - men det kan jeg vel sei filen?

Filer sendt.
Ark = filer, faner = ark i filer.

Har du afprøvet sidste version?

Har desværre ikke haft tid, men har ferie i næste uge så regner jeg med at få afsluttet projektet.

Så har jeg kikket på det :-)
Bare iorden, men er det let af flytte macroen til fil2 da fil1 slettes/overskrives efter endt brug?

Hvorledes flyttes macro fra fil1 til fil2

Vi fortsætter i http://www.eksperten.dk/spm/853086
læg svar, hvis du vil have points.

Det får du så...

tak for hjælpen.