Macro + durée

Merci mais personne ne passe ... :(

Bonjour michel_m,

Ce n'est pas grave si c'est encore plus long, par contre je ne peux pas mettre le fichier sur cjoint ... il n'y a que des données confidentielles,

Mais il n'existe pas un chronometre "tout fait" qui se lance (peu importe le fichier qui est fait derrière ?

Bravo, beau travail,

Mais comment y incorporer à mon fichier ?

Voici le code qui prend du temps :

Sub Reglement_posterieur()
Dim l As Long
'
' export
'

'
    Application.ScreenUpdating = False
    Windows("Export.xlsx").Activate
    Range("A1:R1572").Select
    Selection.Copy
    Windows("Balance_Modèle_RGMT.xlsm").Activate
    Sheets("Export").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("A1").Select

'
' mise en forme dans onglet balance
'

'
    Sheets("Export").Select
    Cells.Select
    Selection.Copy
    Sheets("Balance").Select
    Range("A1").Select
    ActiveSheet.Paste
    Columns("A:K").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("B:B,C:C").Select
    Range("C1").Activate
    Selection.Delete Shift:=xlToLeft
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:D").Select
    Selection.NumberFormat = "General"

'
' mise en place avance suppresion
'

'
    Sheets("Balance").Select
    Range("D2").Select
    ActiveCell.FormulaLocal = _
        "=SI(B2<Commande!$A$1;0;""test"")"
    Range("D2").Select
    Selection.AutoFill Destination:=Range("D2:D5000")

'suppression


Sheets("Balance").Select
For l = Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
    If Cells(l, "D").Value = 0 _
    Then Cells(l, 1).EntireRow.Delete
Next l

    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    
    Application.ScreenUpdating = True

Je ne m'y connais pas du tout en VBA donc les .select copy/paste sont les seuls que je "connaissent"

cherches tu à copier les données seules ou les données avec le formats ?

Les donées seules, pourquoi ?

ci dessous macro

a voir pour le principe (sans les select-selection,copy-paste) car travailler sans avoir le classeur sous les yeux implique forcément un plantage de la macro
suivant la durée, tu verras si il est nécessaire d'installer ton chrono


dans la feuille "export" d'après ce que tu as fait, j'ai cru comprendre qu'il y avait d'autres données en dehors de A1:R1572 d'où la recherche d'une nouvelle dernière cellule non vide (attention s'il y a des zéros)

dans la partie avec calcul de D2, j'ai cru comprendre qu'il y avait des étiquettes en ligne1, ce qui permet l'utilisation d'un filtre + rapide qu'une boucle

Sub Reglement_posterieur_retour() 

Start = Timer 
'----export 
    Application.ScreenUpdating = False 
    Windows("Export.xlsx").Activate  'll serait prudent d'indiquer la feuille 
    T_export = Range("A1:R1572").Value 
    
     With Windows("Balance_Modèle_RGMT.xlsm").Sheets("Export") 
          .Range("A1:R1572") = T_export 
          T_export = "" 
          '----mise en forme dans onglet balance 
          fin = .Cells.SpecialCells(xlCellTypeLastCell).Address 
          T_interne = Range("$A$1:" & fin).Value 
     End With 
      
     With Sheets("Balance") 
          .Range("A1:" & fin) = T_interne 
          .Columns("A:K").Delete 
          .Columns("B:C").Delete 
          .Range("C1").Delete  '????? pas compris 
          .Columns("D").Delete 
          .Columns("D").NumberFormat = "general"  'utilité car destruction  colonne à la fin ???
     
     ' mise en place avance suppresion 
         .Range("D2").FormulaLocal = "=SI(B2<Commande!$A$1;0;""test"")" 
          fin = .Cells.SpecialCells(xlCellTypeLastCell).Address 
          derlig = Columns(1).Find("*", , , , , xlPrevious).Row 
          .Range("D2").AutoFill Destination:=Range("D2:D" & derlig) 
          .Activate 
      End With 
          'suppression par filtre 
           
          Range("A1:" & fin).AutoFilter Field:=4, Criteria1:="0" 
          Range("$A$2:" & fin).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp 
         ActiveSheet.ShowAllData 
          Columns("D").Delete 
          Rows(1).Delete 
      
     End With 
    MsgBox " durée : " & Timer - Start & " sec."

end sub

Mwouais ... bof