Start af makro

Prøv at sende din fil med makroen til pb@supertekst-it.dk
Forstår ikke helt hvad du mener - makroen skulle vel ikke bliver overskrevet, fordi du gemmer regnearket under et andet navn?

Hej igen.. er den makro du har lavet!!  Jeg vil gemme regnearket under den samme navn...de dato jeg får ovf. bliver lagt over i et navnløst exelark...det vil jeg så gemme i det navn hvor makroen ligger..med gem som.. men så vil makroen jo forsvinde!

OK - så er jeg med.
Løsningsmuligheder - som jeg ser det:
- 1) kopiere data fra "det navnløse ark" over til filen med makroen
- 2) gemme det "navnløse ark" under et andet navn og ændre makroen, således at man kan vælge og behandle enhver xls.fil
- 3) gemme makroen som xla - d.v.s. som tilføjelsesprogram - som kan anvendes i Excel på enhver fil

Kan det køre som et tilføjelsesprogram?

Ja - er afprøvet:

Koden er justeret - indlægges i et tomt regneark - i VBA's Ark1
Gem herefter filen som Excel-tilføjelsesprogram(*.xla)under FILTYPE
FilNavn: UdtræksFilter (f.eks)
-
Åbn herefter det nye udtræk (navnløse fil) - Funktioner / Tilføjelsesprogram - sæ flueben v/Udtræksfilter - OK

Start VBA-koden via Alt+F11 - så skulle det køre - ellers må du sige til...


Rem VERSION 2
Rem =========
Rem Koden indlægges i det ark, hvor filtrering ønskes
Dim InitListe As Variant
Sub starFilter()                                          'VBA begynder her - evt. tilknyttes knap
 
Rem Liste over initialer, der IKKE skal slettes
Rem ===========================================
    InitListe = Array("AHS", "HCA", "IMP", "JRK", "LNL", "MPR", "OGK", "SGJ")  '<-----Tilpasses
    udførFiltrering
End Sub
Private Sub udførFiltrering()
Dim antalRæk
    ActiveWorkbook.Sheets(1).Activate
   
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
   
    For ræk = antalRæk To 2 Step -1
        If ActiveSheet.Cells(ræk, 1) <> "" Then
            If InitBevares(ActiveSheet.Cells(ræk, 1)) = False Then
                ActiveSheet.Rows(ræk).Delete
            End If
        End If
    Next ræk
End Sub
Private Function InitBevares(init)
    For f = 0 To UBound(InitListe)
        If init = InitListe(f) Then
            InitBevares = True
            Exit Function
        End If
    Next f
    InitBevares = False
End Function

Kører fint...sender du et svar!!

p.s.  må jeg sende dig koden til dig, jeg har selv bygget noget på (pivotabel), men jeg er tvivl om det hele måske kunne gøres ved hjælp af en pivottabel.

så kan jeg oprette et spørgsmål, når du har kigget på det

Det får du så - prøv blot at sende koden vedr. pivot

fint gør jeg