macro pour extraire des données avec condition

Sub NouveauFichier()
Dim col%, chemin$, fichier$
Application.ScreenUpdating = False
'---nouveau document---
Workbooks("base.xls").Sheets("Sheet1").Copy
With ActiveWorkbook.Sheets(1).UsedRange
  col = .Columns.Count + 1
  .Columns(col).FormulaR1C1 = "=LN(RC45*0.75<=RC57)"
  .Columns(col) = .Columns(col).Value
  .Resize(, col).Sort .Columns(col), xlAscending, Header:=xlYes
  On Error Resume Next
  .Columns(col).Offset(1).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
  .Columns(col).ClearContents
End With
'---enregistrement---
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = "Mon beau fichier " & Format(Now, "dd-mm-yyyy") 'à adapter
ActiveWorkbook.SaveAs chemin & fichier
ActiveWorkbook.Close False 'facultatif
End Sub

Sub NouveauFichier()
Dim chemin$, source$, nom$, col%, nouveau$
chemin = ThisWorkbook.Path & "\" 'à adapter
source = "base.xls"
nom = ActiveWorkbook.Name
Application.ScreenUpdating = False
On Error Resume Next
Workbooks.Open chemin & source 'ouverture du fichier source
'---nouveau document---
Workbooks(source).Sheets(1).Copy
If ActiveWorkbook.Name = nom Then _
  MsgBox "Fichier '" & source & "' introuvable !": Exit Sub
With ActiveWorkbook.Sheets(1).UsedRange
  col = .Columns.Count + 1
  .Columns(col).FormulaR1C1 = "=LN(RC45*0.75<=RC57)"
  .Columns(col) = .Columns(col).Value
  .Resize(, col).Sort .Columns(col), xlAscending, Header:=xlYes
  .Columns(col).Offset(1).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
  .Columns(col).ClearContents
End With
'---enregistrement---
nouveau = "Mon beau fichier " & Format(Now, "dd-mm-yyyy") 'à adapter
ActiveWorkbook.SaveAs chemin & nouveau
ActiveWorkbook.Close False 'facultatif
Workbooks(source).Close 'facultatif
End Sub

Workbooks(source).Sheets(1).Copy

Sub RécupDonnées()
  Dim sPath As String, sFic As String
  Dim ShtD As Worksheet
  Dim DLig As Long, Lig As Long, NLig As Long
  '
  ' Définir le chemin d'accés au fichier
  sPath = ThisWorkbook.Path & "\"
  '
  ' Définir le nom du fichier à ouvrir
  sFic = "base.xls"
  ' Définir la feuille de destination des données
  Set ShtD = ThisWorkbook.Worksheets("Données")
  ShtD.Cells.ClearContents
  '
  ' Ouvrir le fichier
  Workbooks.Open sPath & sFic
  ' Trouver la dernière ligne de la feuille
  With ActiveWorkbook.Sheets(1)
    ' Trouver le numéro de la dernière ligne remplie
    DLig = .Range("A" & Rows.Count).End(xlUp).Row
    ' Pour chaque ligne
    For Lig = 2 To DLig
      ' AS x 0.75 soit inferieur ou égal a BE.
      If .Range("AS" & Lig).Value * 0.8 <= .Range("BE" & Lig).Value Then
        ' Trouver la prochaine ligne vide de la feuille de destination
        NLig = ShtD.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
        ' Copier / coller la ligne correspondant au critére
        .Rows(&O1).Copy Destination:=ShtD.Rows(&O1)
        .Rows(Lig).Copy Destination:=ShtD.Rows(NLig)
      End If
    Next Lig
  End With
  ' Fermer le classeur à la fin
  ActiveWorkbook.Close SaveChanges:=xlNo
  ' Enregistrer la feuille données dans un autre classeur
  ShtD.Copy After:=Workbooks("***\EtatBudget\ComptesDanger.xlsx").Sheets(1)
  
  'With ActiveWorkbook
    '.SaveAs "***\EtatBudget\ComptesDanger.xlsx"
    '.Close SaveChanges:=xlNo
    'End With
    'ActiveWorkbook.Close SaveChanges:=xlNo
    'Application.Quit
  ' Petit message
' MsgBox "C'est fini"
End Sub

ShtD.Copy After:=Workbooks("***\EtatBudget\ComptesDanger.xlsx").Sheets(1)