Macro loopt traag - bestand excel is groot

[Caro1981]

Ik heb een lijst in excel waarin ik wil filteren en bepaalde kolommen wil plakken in een ander blad. De macro is wat traag. Maar vooral de grootte van het bestand is heel groot? Ligt dit aan mijn code?
Mijn code ziet er als volgt uit:

Application.ScreenUpdating = False
    Sheets("Overzicht P&V").Select
    Range("A:J").Select
    Selection.ClearContents
    
    Dim rngBereik As Range

    Sheets("Basistabel").Select

    Set rngBereik = Range("$A$1:$AE$100")

    rngBereik.AutoFilter Field:=1, Criteria1:="in dienst"

    Range("B:H,U:U,AD:AE").Copy

    Sheets("Overzicht P&V").Select
   
    ActiveSheet.Paste
    Cells.Select
    Cells.EntireColumn.AutoFit
    
    Sheets("Basistabel").Select
    Application.CutCopyMode = False
    ActiveSheet.ShowAllData
    
    Application.ScreenUpdating = True
     Sheets("Overzicht P&V").Select
     Range("A1").Select
     MsgBox "Up-to-date!", vbInformation + vbOKOnly

Alvast bedankt voor de reacties.

 

[edmoor]

Volg dit draadje eens:
https://www.helpmij.nl/forum/showthread.php/952299-Macro-loopt-traag

 

[Caro1981]

Volg dit draadje eens:
https://www.helpmij.nl/forum/showthread.php/952299-Macro-loopt-traag

Deze tip paste ik al toe: Zet aan het begin van de macro Application.ScreenUpdating op False en Application.Calculation op xlCalculationManual
Aan het einde weer op True en xlCalculationAutomatic

Select vermijden is voor mij als leek niet zo eenvoudig. Kan ik dit gewoon weglaten en laten volgen door selection?
Kan je mij dat even op een gemakkelijke manier uitleggen?

 

[edmoor]

Plaats je code tussen codetags en laat ook altijd de heading van de Sub zien.

 

[Caro1981]

Plaats je code tussen codetags en laat ook altijd de heading van de Sub zien.

Sub Mcr_OverzichtPenV()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Sheets("Overzicht P&V").Select
    Range("A:J").Select
    Selection.ClearContents
    
    Dim rngBereik As Range

    Sheets("Basistabel").Select

    Set rngBereik = Range("$A$1:$AE$100")

    rngBereik.AutoFilter Field:=1, Criteria1:="in dienst"

    Range("B:H,U:U,AD:AE").Copy

    Sheets("Overzicht P&V").Select
   
    ActiveSheet.Paste
    Cells.Select
    Cells.EntireColumn.AutoFit
    
    Sheets("Basistabel").Select
    Application.CutCopyMode = False
    ActiveSheet.ShowAllData
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
     Sheets("Overzicht P&V").Select
     Range("A1").Select
     MsgBox "Up-to-date!", vbInformation + vbOKOnly
End Sub

 

[edmoor]

Plaats ook je document, anders is het lastig om te bouwen.

 

[Caro1981]

Plaats ook je document, anders is het lastig om te bouwen.

ik kan het document niet uploaden waarschijnlijk te groot.
Waar vind ik info over hoe ik select kan vermijden?

 

[edmoor]

Voorbeeldje:

Sheets("Basistabel").Select

    Set rngBereik = Range("$A$1:$AE$100")

Set rngBereik = Sheets("Basistabel").Range("A1:AE100")

Daarnaast wat ik in #2 zei in de link die ik gaf.

 

[Caro1981]

Voorbeeldje:

Sheets("Basistabel").Select

    Set rngBereik = Range("$A$1:$AE$100")

Set rngBereik = Sheets("Basistabel").Range("A1:AE100")

Daarnaast wat ik in #2 zei in de link die ik gaf.

De code loopt dan vast op activesheet.paste? Fout 1004 tijdens uitvoering: dit is een ongeldige selectie. zorg ervoor dat de kopieer en plakgebeiden elkaar niet overlappen, tenzij ze dezelfde grootte en vorm hebben

 

[edmoor]

Uiteraard moet de rest van de code er ook op aangepast worden.

 

[Caro1981]

Uiteraard moet de rest van de code er ook op aangepast worden.

Ja, dat klopt. Maar ik selecteer toch een ander blad om het gekopieerde daar dan te plakken.
Wat heeft dat dan met de code te maken waar ik mijn gegevens haal.

Ik weet dat ik minder select moet gebruiken, maar dat is precies niet zo eenvoudig....

 

[edmoor]

Ik kan er zonder je document verder weinig aan veranderen.
Je kan uiteraard ook een voorbeeld van het document plaatsen die kleiner en geanonimiseerd is.

 

[jkpieterse]

Probeer het hier eens mee:

Sub Mcr_OverzichtPenV()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Sheets("Overzicht P&V").Range("A:J").ClearContents

    Dim rngBereik As Range


    Set rngBereik = Sheets("Basistabel").Range("$A$1:$AE$100")

    rngBereik.AutoFilter Field:=1, Criteria1:="in dienst"

    With Sheets("Basistabel")
        Intersect(.UsedRange, .Range("B:H,U:U,AD:AE")).Copy
    End With
    With Sheets("Overzicht P&V")
        .Paste
        .Cells.EntireColumn.AutoFit
    End With
    Application.CutCopyMode = False
    Sheets("Basistabel").ShowAllData

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Range("A1").Select
    MsgBox "Up-to-date!", vbInformation + vbOKOnly
End Sub

 

[Caro1981]

De code werkt.
Ik ga ze eens ontleden zodat ik ze begrijp.
Ik moet juist de code nog aanpassen m.b.t. de opmaak van het tabblad zodat het bestand minder groot is. Dat zal me wel lukken.
Dikke merci voor de hulp.

 

[snb]

Maar vooral de grootte van het bestand is heel groot?

Na veel knippen en plakken heb je vaak veel onzichtbare afbeeldingen of voorwaardelijke opmaakregels in het bestand staan:

Sub M_snb()
  for each it in sheets
    msgbox it.shapes.count
  next
End Sub

 

[VenA]

Als je kolomkoppen gebruikt dan kan je hetzelfde bereiken met het geavanceerde filter.

Sub VenA()
  Sheets("Overzicht P&V").Cells(1).CurrentRegion.Offset(1).ClearContents
  With Sheets("Basistabel")
    .Cells(2, 26).FormulaR1C1 = "=RC[-25]=""In dienst"""
    .ListObjects(1).Range.AdvancedFilter xlFilterCopy, .Range("Z1:Z2"), Sheets("Overzicht P&V").Range("A1:C1")
    .Cells(2, 26).Clear
  End With
End Sub

 

[HSV]

Zonder formule:

Sheets("Overzicht P&V").Cells(1).CurrentRegion.Offset(1).ClearContents
  With Sheets("Basistabel")
[COLOR=#ff0000]    .Range("z1:z2") = Application.Transpose(Array("status", "in dienst"))[/COLOR]
    .ListObjects(1).Range.AdvancedFilter xlFilterCopy, .Range("Z1:Z2"), Sheets("Overzicht P&V").Range("A1:C1")
    .Range("z1:z2").Clear
  End With