Data sortering

Ja ALT er muligt med Excel ;)

Men det er svært at komme med tips, når de pågældende Excel ark ikke kendes.

Og versionen af Excel (Officepakke)

Men ofte bruger jeg selv den simple løsning.. At indsætte (evt. skjulte) sorteringer (formler) i det oprindelige ark, og så KUN lade disse info "kædes" til det andet ark.

Det kan laves med data sortering (indbygget i Excel), ved at vælge "Data", "Filtrering" og "Avanceret", og der kan du så vælge data der skal filtreres, og hvor de skal flyttes hen, og om det skal være unikke data (entydige poster).

Eller det kan laves med Indeks Sammenligning, og TÆL.HVIS Formel.

Ja VBA er oplagt at anvende til denne situation
Evt uploade en demo version eller via direkte kontakt til www.supertekst.dk  så sender jeg svar

Jeg har en demo version, men hvordan uploader man det her?

Aktiver kontakten på min www så får du min @-adresse

www.supertekst.dk virker ikke, jeg bliver bare sendt til dandomain. Er det supertekst-it.dk?

Du kan også bruge www.dropbox.com

#6 - ja www.supertekst-it.dk

Forslag til løsning:
Rem =============== Version 1 =============================
Rem VBA-kode indsættes i Data.xlsx -- .ext rettet --> .xlsm
Rem =======================================================
Rem FÆLLES
Rem ======
Dim aktuelleSti As String
Dim serieNr As Long

Rem DATA
Rem ====
Const dataArkNavn = "DATA"
Dim dataXLS As Object
Dim antalRæk As Integer

Rem HOVEDMAPPE
Const hovedMappeNavnSkabelon = "Hovedmappe1.xlsx"      '<------ rettet
Const hovedarkNavn = "Hovedark"
Dim hmapXLS As Object
Public Sub overførDataTilHovedMappe()
Dim Ræk As Integer
    houseKeeping
   
    For Ræk = 2 To antalRæk
        serieNr = Range("H" & Ræk)
       
        kopierDataTilHovedmappe Ræk, serieNr
    Next Ræk
   
    afSlutning
End Sub
Private Sub houseKeeping()                          'klargøring
    aktuelleSti = ThisWorkbook.Path
    If Right(aktuelleSti, 1) <> "\" Then
        aktuelleSti = aktuelleSti & "\"
    End If
   
    Set dataXLS = ThisWorkbook
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
       
    Set hmapXLS = CreateObject("Excel.Application")
    hmapXLS.Workbooks.Open aktuelleSti & hovedMappeNavnSkabelon
   
    Application.ScreenUpdating = False
End Sub
Private Sub kopierDataTilHovedmappe(Ræk, serieNr)
Dim hmapRække As Integer, arkNavn As String, arkAntalRæk As Integer, arkRæk As Integer
Rem marker range i DATA
    With dataXLS
        ActiveSheet.Range("A" & Ræk & ":H" & Ræk).Select
        Selection.Copy
    End With
   
Rem find serienr i Hovedark
    With hmapXLS
        .Sheets(hovedarkNavn).Activate
       
        For hmapRække = 2 To .ActiveCell.SpecialCells(xlLastCell).Row
            If .Range("A" & hmapRække) = serieNr Then
                arkNavn = .Range("B" & hmapRække)
                hmapXLS.Sheets(arkNavn).Activate
                arkAntalRæk = hmapXLS.ActiveCell.SpecialCells(xlLastCell).Row
               
                With hmapXLS.ActiveSheet
                    .Range("A" & arkAntalRæk + 1).Select
                    .Paste
                End With
               
                hmapXLS.ActiveWorkbook.Save
                Exit For
            End If
        Next hmapRække
    End With
   
    dataXLS.Application.CutCopyMode = False
End Sub
Private Sub afSlutning()
    hmapXLS.Application.Quit
    Set hmapXLS = Nothing
End Sub