Opsalg eller noget ?!?!

du kan jo bruge Data / Filter / Avanceret filter til det, sådan som jeg lige ser det.

Prøver lige

Jeg kan ikke rigtig få det til at funke :o(

sandheden er at jeg har flere lister på ark1 og resultatet på akr2 skal også være flere lister :o) og jeg kan ikke lave flere sorteringer på samme ark :-/

Chewie

okay - mon ikke en makro ku se ud som denne her:

Public Sub demo()
    Const sCopyFrom As String = "Ark1"
    Const sCopyTo As String = "Ark2"
    Dim rCell As Range
   
    For Each rCell In Worksheets(sCopyFrom).Range("D1:D100")
        If Not (rCell.Value = "") Then
            With Worksheets(sCopyTo).Range(Range("A655362").End(xlUp).Offset(1, 0).Address)
                .Value = rCell.Offset(0, -3).Value
                .Offset(0, 1).Value = rCell.Offset(0, -2).Value
                .Offset(0, 2).Value = rCell.Offset(0, -1).Value
                .Offset(0, 3).Value = rCell.Value
            End With
        End If
    Next rCell
   
    Set rCell = Nothing
End Sub

Jeg syns nu godt jeg plejer at kunne læse makroerne .... men den der fatter jeg ikke noget at :(

Hvor skal jeg indsætten
Hvor stå hvilke område den kan kigge på
hvor stå der hvor den skal indsætte dataen

"stavefejl er gratis" :o)

Skal placeres i et almindeligt kodemodul - og du skal ændre på arknavnene i konstanterne (const-linierne)
Område der kigges på Worksheets(sCopyFrom).Range("D1:D100")
Område der sættes ind i Worksheets(sCopyTo).Range(Range("A655362").End(xlUp).Offset(1, 0).Address)

Arrhh .... jeg kan ikke få det til at funke :'( ...... kan jeg prøve at sende arket til dig ?

ja - det må du gerne

Ellers test denne
Option Explicit
Option Base 1
Sub KopierUdenTomme()
Dim rng_In As Range
Dim rng_Out As Range
Dim var_In As Variant
Dim arr_Out()
Dim i As Long, j As Long, x As Long
Set rng_In = Application.InputBox("Område der skal kopieres", Type:=8)
Set rng_Out = Application.InputBox("Startcelle for nyt område", Type:=8)
var_In = rng_In
ReDim arr_Out(4, UBound(var_In, 1))
For i = 1 To UBound(var_In, 1)
    If Len(var_In(i, 4)) >= 1 Then
    x = x + 1
        For j = 1 To 4
            arr_Out(j, x) = var_In(i, j)
        Next
    End If
Next
ReDim Preserve arr_Out(4, x)
rng_Out.Resize(x, 4) = Application.WorksheetFunction.Transpose(arr_Out)
End Sub

sendt

Bak - det ser ikke helt ud som beskrevet :-)

Public Sub demo()
    Const sCopyFrom As String = "Ark1"
    Const sCopyTo As String = "Ark2"
    Dim rCell As Range
   
    For Each rCell In Worksheets(sCopyFrom).Range("J6:J29")
        If Not (rCell.Value = 0) Then
            rCell.EntireRow.Copy
            Worksheets(sCopyTo).Range(Range("A65536").End(xlUp). _
                Offset(1, 0).Address).PasteSpecial xlPasteValues
        End If
    Next rCell
   
    Application.CutCopyMode = False
    Set rCell = Nothing
End Sub

Ok :-)

sorry .. jeg forsvandt :o)

Men jeg har vent op og ned på mit ark ... da jeg ikke syns det var særlig smart sat op :o)

flemmming >> når man kører din formel ender resultatet på ark2 i række 85 ... hvordan styre jeg hvor de skal lande ?

chewie

måske du har et mellemrum i række 84 eller noget ?!! Data lander i 2. tomme række

undskyld måske du har noget i række 83

OK ..... ark´et var helt tomt ... men det funkede da jeg slettede arket og oprettede det i ark3 (typisk excel ... husker for godt:o)

mange tak for hjælpen

:-)

bak >> der er lidt points at hente her for din reponce

http://www.eksperten.dk/spm/335931