kopier fra ark1 til ark2

Du skal først kopiere det du har på Ark2 over i ark 3 og 4.

Ret så AL2 til det nummer der skal filtreres på i ark 3 +4

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Columns.Count = 1 And Target.Column = 38 Then    ' 38 = kolonne AL
' Filtrerer data fra ark1 over i ark2+3+4, hvor modtager arket [AL2] har det tal der skal filtreres på

        'Ark2
        Sheets("Ark1").Range("A2:AL1000").AdvancedFilter Action:=xlFilterCopy, _
                                                        CriteriaRange:=Sheets("Ark2").Range("AL1:AL2"), CopyToRange:=Sheets("Ark2").Range("A2:P1000"), Unique:= _
                                                        False
        Sheets("Ark2").Range("A3").CurrentRegion.Font.Size = 10    ' retter skriftstørrelsen i ark2
        Sheets("Ark2").Range("A2").End(xlDown).Offset(1, 0).EntireRow.Delete    ' sletter den første tomme linje, så formater slettes
       
        ' Ark3
        Sheets("Ark1").Range("A2:AL1000").AdvancedFilter Action:=xlFilterCopy, _
                                                        CriteriaRange:=Sheets("Ark3").Range("AL1:AL2"), CopyToRange:=Sheets("Ark3").Range("A2:P1000"), Unique:= _
                                                        False
        Sheets("Ark3").Range("A3").CurrentRegion.Font.Size = 10    ' retter skriftstørrelsen i ark2
        Sheets("Ark3").Range("A2").End(xlDown).Offset(1, 0).EntireRow.Delete    ' sletter den første tomme linje, så formater slettes
       
        'Ark4
          Sheets("Ark1").Range("A2:AL1000").AdvancedFilter Action:=xlFilterCopy, _
                                                        CriteriaRange:=Sheets("Ark4").Range("AL1:AL2"), CopyToRange:=Sheets("Ark4").Range("A2:P1000"), Unique:= _
                                                        False
        Sheets("Ark4").Range("A3").CurrentRegion.Font.Size = 10    ' retter skriftstørrelsen i ark2
        Sheets("Ark4").Range("A2").End(xlDown).Offset(1, 0).EntireRow.Delete    ' sletter den første tomme linje, så formater slettes
    End If
End Sub

Hej kabak  har prøvet at sætte ind men den kommer med en fejl.
min nuværende streng som virker ser sådan ud

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Columns.Count = 1 And Target.Column = 16 Then    ' 16 = kolonne P
' Filtrerer data fra ark1 over i ark2, hvor celler i P kolonnen = 1
        Sheets("Ark1").Range("A2:P1000").AdvancedFilter Action:=xlFilterCopy, _
                                                        CriteriaRange:=Sheets("Ark2").Range("P1:P2"), CopyToRange:=Sheets("Ark2").Range("A2:O1000"), Unique:= _
                                                        False
        Sheets("Ark2").Range("A3").CurrentRegion.Font.Size = 10    ' retter skriftstørrelsen i ark2
        Sheets("Ark2").Range("A2").End(xlDown).Offset(1, 0).EntireRow.Delete    ' sletter den første tomme linje, så formater slettes
    End If
End Sub

den burde virke, hvis du tager kopi af denne

    Sheets("Ark1").Range("A2:P1000").AdvancedFilter Action:=xlFilterCopy, _
                                                        CriteriaRange:=Sheets("Ark2").Range("P1:P2"), CopyToRange:=Sheets("Ark2").Range("A2:O1000"), Unique:= _
                                                        False
        Sheets("Ark2").Range("A3").CurrentRegion.Font.Size = 10    ' retter skriftstørrelsen i ark2
        Sheets("Ark2").Range("A2").End(xlDown).Offset(1, 0).EntireRow.Delete    ' sletter den første tomme linje, så formater slettes


Sætter den lige over End if, og retter alle steder som der står Ark2 til Ark3.

det samme for Ark4

den flytter godt jeg har lavet det som nedenfor
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Columns.Count = 1 And Target.Column = 16 Then    ' 16 = kolonne P
' Filtrerer data fra ark1 over i ark2, hvor celler i P kolonnen = 1
        Sheets("Ark1").Range("A2:P1000").AdvancedFilter Action:=xlFilterCopy, _
                                                        CriteriaRange:=Sheets("Nye ridehaller").Range("P1:P2"), CopyToRange:=Sheets("Nye ridehaller").Range("A2:O1000"), Unique:= _
                                                        False
        Sheets("Nye ridehaller").Range("A3").CurrentRegion.Font.Size = 10    ' retter skriftstørrelsen i ark2
        Sheets("Nye ridehaller").Range("A2").End(xlDown).Offset(1, 0).EntireRow.Delete    ' sletter den første tomme linje, så formater slettes
       
        Sheets("Ark1").Range("A2:P1000").AdvancedFilter Action:=xlFilterCopy, _
                                                        CriteriaRange:=Sheets("Nye udebaner").Range("P1:P2"), CopyToRange:=Sheets("Nye udebaner").Range("A2:O1000"), Unique:= _
                                                        False
        Sheets("Nye udebaner").Range("A3").CurrentRegion.Font.Size = 10    ' retter skriftstørrelsen i ark2
        Sheets("Nye udebaner").Range("A2").End(xlDown).Offset(1, 0).EntireRow.Delete    ' sletter den første tomme linje, så formater slettes
   
        Sheets("Ark1").Range("A2:P1000").AdvancedFilter Action:=xlFilterCopy, _
                                                        CriteriaRange:=Sheets("Service").Range("P1:P2"), CopyToRange:=Sheets("Service").Range("A2:O1000"), Unique:= _
                                                        False
        Sheets("Service").Range("A3").CurrentRegion.Font.Size = 10    ' retter skriftstørrelsen i ark2
        Sheets("Service").Range("A2").End(xlDown).Offset(1, 0).EntireRow.Delete    ' sletter den første tomme linje, så formater slettes
    End If
End Sub

men så kommer den med runtime erro 1004 så når jeg trykker på debug er der gul markering ud for  Sheets("Nye udebaner").Range("A2").End(xlDown).Offset(1, 0).EntireRow.Delete    ' sletter den første tomme linje, så formater slettes

Hej Kabbak nu ser det ud til at virker har slette den strengen Sheets("Nye ridehaller").Range("A2").End(xlDown).Offset(1, 0).EntireRow.Delete    ' sletter den første tomme linje, så formater slettes
i alle 3 ark så gør den det ikke men sletter så heller ikke de rammer der står tilbage så hvis du har ændringer må du gerne komme med ellers mange tak og det er ok hvis du smidder et svar

"alle 3 ark så gør den det ikke men sletter så heller ikke de rammer der står tilbage så hvis du har ændringer må du gerne komme med ellers mange tak og det er ok hvis du smidder et svar"

Forstået sådan at den ikke sletter i nogen af de 3 ark, var der fejl ved alle.??

jo det virker godt nok vis jeg sætter 1,2,3 kopier den fint til de 3 ark og vis jeg sletter 1,2,3 igen sletter den fint det den har kopieret men fordi jeg har ramme omkring i ark1 flytter den også med og det er også fint men den sidste slettes ikke men det gør ikke noget det er kun kosmetisk men er der en løsning

Sheets("Nye ridehaller").Range("A1").End(xlDown).Offset(1, 0).EntireRow.Delete    ' sletter den første tomme linje, så formater slettes

Prøv, jeg rettede A2 til A1, jeg tror fejlen kom, fordi der ikke var data i A2

der sker det så. første gang jeg sætter 1,2,3 kopier den ikke men anden gang jeg sætter 1,2,3 kopier den og den sletter også igen det hele

Send lige et eksempel til
kabbak snabela tiscali dot dk
så ser jeg på det i aften

ok sender iaften

Koden er flyttet til de respektive ark, og ser sådan ud.

Private Sub Worksheet_Activate()
Rw = Cells.SpecialCells(xlCellTypeLastCell).Row
Range("A3:A" & Rw).EntireRow.Delete  ' sletter inden ny data

        Sheets("Ark1").Range("A2:P1000").AdvancedFilter Action:=xlFilterCopy, _
                                                        CriteriaRange:=Range("P1:P2"), CopyToRange:=Range("A2:O1000"), Unique:= _
                                                        False
    Range("A3").CurrentRegion.Font.Size = 10    ' retter skriftstørrelsen i ark2
End Sub

og et svar ;-))

Hej det er bare super du ka bare det mange tak

husk at markere mit navn og tryk så accepter, så vi kan få lukket. ;-))