Gem kun relevante data fra flere ark

Lyder spændende.

Hilsen KOL

Tjaa, hvorfor ikke bruge 1 eller 2 - eller en kombination haraf, nemlig Kopiere ønskede data til ny projektmappe vha. en macro? /Martin

Dette er bare et forslag til en makro, da jeg jo ikke kender de præcise data:

Sub Flyt()

\'Indsætter et nyt ark, der hedder \"Nyt\"
Sheets.Add After:=Worksheets(Worksheets.Count)
Sheets(Sheets.Count).Name = \"Nyt\"

Sheets(\"Gammelt\").Select \' kunne også være Ark1
Application.CutCopyMode = False

\'Tæller rækker
række = 1
Do
    række = række + 1
Loop Until (Cells(række, 1) = \"\")

\'gennemløber alle talte rækker og kopiere dem til andet ark

y = 0
For n = 1 To række
    If Cells(n, 1).Value <> \"en eller anden værdi\" Then
        Rows(n - y).Copy
        Sheets(\"Nyt\").Select
        Rows(n).Select
        ActiveSheet.Paste
        Sheets(\"Gammelt\").Select
    Else
        y = y - 1
    End If
Next n
   
End Sub

Denne makro opretter et nyt ark og kopier alle data fra alle andre ark ind i det nyt nye ark under hinanden. Det er dog en forudsætning at alle dine styklister starter i A1 og ikke har tomme linier. Det med A1 kan du ændre du ændre i linien Range(\"A1\").select
Sub kopieralledata()
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = \"Nyt\"
For Each sh In ThisWorkbook.Worksheets
    If sh.Name = \"Nyt\" Then GoTo springover
    sh.Select
    Range(\"A1\").Select
    Set rngA = Selection.CurrentRegion
    rngA.Copy
    Worksheets(\"Nyt\").Activate
    Range(\"A65536\").End(xlUp).Offset(2, 0).Select
    ActiveSheet.Paste
springover:
Next
End Sub

Du kan da ikke bare afvise uden at skrive hvorfor!!

->bak - kopieringen fungerer fint, men selve fravalget at \"overflødige\" data mangler - og så har jeg tomme linier i min liste -
->rvm - der er noget omkring \"række = 1\" som glipper, mangler der ikke noget?

Sorry rvm - fejl 40 (fra knapperne og bagud) - håber min kommentar råder bod på dette ??!!

Ok, hvor mange KOLONNER bruger dine styklister???
Rækkerne klarer jeg selv.
BAK

antal, type, varebeskrivelse, salgspris, kostpris - altså 5 (måske udvides til 6)
/Flemming

Ok *S*

Nu ar jeg testet min kode lidt nærmere så nu kopierer den alle rækker hvor der er noget i første kolonne over i et nyt ark:

Sub Flyt()

\'Indsætter et nyt ark, der hedder \"Nyt\"
Sheets.Add After:=Worksheets(Worksheets.Count)
Sheets(Sheets.Count).Name = \"Nyt\"

Sheets(\"Gammelt\").Select \' kunne også være Ark1
Application.CutCopyMode = False

ActiveCell.SpecialCells(xlLastCell).Select
Række = ActiveCell.Row

\'gennemløber alle talte rækker og kopiere dem til andet ark
y = 0
For n = 1 To Række
    If Cells(n, 1).Value <> \"\" Then
        Rows(n).Copy
        Sheets(\"Nyt\").Select
        Rows(n + y).Select
        ActiveSheet.Paste
        Sheets(\"Gammelt\").Select
    Else
        y = y - 1
    End If
Next n
   
End Sub

Prøv så denne, men jeg er ikke helt sikker på hvad du mener med fravalg af overflødige data.

Sub kopieralledata()
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = \"Nyt\"
For Each sh In ThisWorkbook.Worksheets
    If sh.Name = \"Nyt\" Then GoTo springover
    sh.Select
    Set rngA = Range(\"A1\", Range(\"A65536\").End(xlUp).Offset(1, 6))
    rngA.Select
    JaNej = MsgBox(\"Skal dette kopiers over ??\", vbYesNo)
    If JaNej = vbNo Then GoTo springover
    rngA.Copy
    Worksheets(\"Nyt\").Activate
    Range(\"A65536\").End(xlUp).Offset(2, 0).Select
    ActiveSheet.Paste
springover:
Next
End Sub

du kan evt. erstatte
Range(\"A65536\").End(xlUp).Offset(1, 6))
med
ActiveCell.SpecialCells(xlLastCell))
Det gør det lidt mere flydende havd der kopieres over.

Jeg ser nu at bak arbejder med alle arkene - er det meningen at data fra alle arkene skal over i det samme nye ark - eller skal data fra alle ark over i hvert sit nye ark ?

har ikke nået at teste.
Bak - overflødige data = ikke valgte varer.
rvm - alle data samles på et ark - en slags stykliste

Denne kode kopierer alle rækkerne, der er noget i fra alle arkene til arket \"Nyt\"

Sub Flyt()

\'Indsætter et nyt ark, der hedder \"Nyt\"
Sheets.Add After:=Worksheets(Worksheets.Count)
Sheets(Sheets.Count).Name = \"Nyt\"

\' En tæller til at gemme rækkenummeret fra arket \"Nyt\"
X = 1

\'Gennemløber alle ark
For Each sh In ThisWorkbook.Worksheets
    If sh.Name <> \"Nyt\" Then
        sh.Select
               
        \'returnerer rækkeantal i arket
        ActiveCell.SpecialCells(xlLastCell).Select
        række = ActiveCell.Row
       
        \'gennemløber alle talte rækker og kopiere dem til andet ark, hvis der er noget i
        \'Kolonne A
        Y = 0
        For n = 1 To række
            If Cells(n, 1).Value <> \"\" Then
                Rows(n).Copy
                Sheets(\"Nyt\").Select
                Rows(X).Select
                ActiveSheet.Paste
                X = X + 1
                sh.Select
            End If
        Next n
    End If
Next
End Sub

Hvordan er en varer \"ikke valgt\"

Det er et spørgsmål om, om der er indtastet et antal af en given vare - det er så i min A-kolonne
Konceptet er at jeg har et ark pr. varegruppe - det er ikke alle varegrupper der skal åbnes hvergang - når man så har udvalgt varer + stk-antal - skal alle disse varer overføres til sit eget ark - håber det kan afklare lidt ?

Jeg er gået lidt død i denne opgave.
Richardt og damvej, håber i klarer den!!

Hej damvej

Prøv min ovenstående kode og fortæl mig, om den virker. Den skal sikkert ændres, så den ikke tager overskriftern med fra de enkelte ark, men det er en detalje.

Du kunne også sende mig dit ark, hvilket ville gøre det meget lettere for mig at tilpasse koden. Min email er rvejemad@sca.csc.com

Mvh

Richardt

->rvm - dit forslag returnerer en fejl - Expected function or variable - debug peger på række = activecell.row - kan ikke gennemskue hvorfor !
Som relativ ny bruger - er 30 points rimeligt for denne opgave eller ??

Som den har udviklet sig er det nok lige i underkanten, men ellers er det OK - send mig regnearket, så har jeg klaret den på et øjeblik (håber jeg *S*) - hvilken version af Excel arbejder du forøvrigt med?

->rvm - super - jeg arbejder med Excel 97 - jeg har testet i et kladdeark - jeg mokker lige noget sammen og mailer til dig - nok i løbet af onsdagen, der er problemer med mailserveren på fabrikken.

OK *S* Har forøvrigt lavet koden så den kun tager overskiften een gang - skal nok lægge den færdige kode til beskuelse for alle *S*

-> rvm

Når I nu går \"offline\" kobler I jo os andre af.
Jeg forstår godt, at komplelse opgaver vanskeligt kan løses åbent på Eksperten, men jeg ville da meget gerne have tilsendt det færdige resultat.
Jeg kan selv bruge den til teknisk specifikation ud fra en række ark.

Hilsen KOL

-> kol: Det er netop det jeg mener med at lægge koden til offentlig beskuelse *S*

-> rwm
Godt nok, det havde du også skrevet.
Men jeg ville alligevel meget gerne have det færdige resultat: kol@gvdnet.dk
Vi er ikke alle fortrolige med makroer. Hvor skal din f.eks. lægges ind?
Hvad betyder *S*

Hilsen KOL

Ok *S* (betyder smil - istedet for :-)

*S*

-> points til rvm - tak for hjælpen - det er rvm\'s sidste forslag der er løsningen - altså rvm - case closed!
/Flemming