VBA Macro permettant d'ajuster un onglet par rapport à des données sources

Bonjour,

J'ai un gros fichier avec 3 onglets principaux :

- Un onglet avec mes données brutes

- Un onglet ou j'applique des formules pour faire des checks et modifier des données

- Un onglet où je ressort mes données brutes modifiées

Mes données brutes sont extraites d'un logiciel et copiées/collées dans mon "onglet source" (le nombre de ligne est variable, ça peut aller de 5 000 à 15 000).

Pour faire mes modifs et mes checks, je vais chercher dans mon onglet source mes données. J'ai donc tirer beaucoup plus de ligne que nécessaire afin d'avoir toujours l'exhaustivité de mon onglet "données sources". Et j'ai fait la même chose pour mon onglet "données modifiées". Le problème c'est que ça ralentie énormément mon PC car excel fait des formules sur 25 000 lignes que ma base source en ai 5 000 ou 15 000.

J'aurais voulu savoir s'il était possible par une macro de trouver le numéro de ligne où j'ai ma dernière donnée renseignée dans mon "onglet source", puis que cette macro tire toutes mes lignes sur les deux autres onglets jusqu'au numéro de ligne trouvé précédemment et qu'elle supprime les lignes suivantes pour alléger le fichier.

7macro.zip (125.65 Ko)

Je ne sait pas si je me suis bien fait comprendre^^.

Merci pour vos réponses

Bonjour,

A tester :

Option Explicit

Sub Test()

Dim DerniereLigneSource As Long, DerniereLigneFormules As Long, DerniereLigneDonnees As Long
Dim DerniereColonneFormules As Long, DerniereColonneDonnees As Long
Dim ShSource As Worksheet, ShFormules As Worksheet, ShDonnees As Worksheet
Dim HeureDebut, HeureFin, TempsTotal

    On Error GoTo Fin

    HeureDebut = Timer    ' Définit l'heure de début.

    With Application
         .ScreenUpdating = False
         .Calculation = xlCalculationManual
    End With

    Set ShSource = Sheets("Donnes sources")
    Set ShFormules = Sheets("Formules (2)")
    Set ShDonnees = Sheets("Données modifiées (2)")

    With ShSource
         DerniereLigneSource = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With

    With ShFormules
         DerniereLigneFormules = DerniereLigneSource
         DerniereColonneFormules = .Cells(1, .Columns.Count).End(xlToLeft).Column
         .Range(.Cells(2, 1), .Cells(2, DerniereColonneFormules)).Copy
        With .Range(.Cells(2, 1), .Cells(DerniereLigneFormules, DerniereColonneFormules))
             .PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
             .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End With
        .Range(.Cells(DerniereLigneFormules + 1, 1), .Cells(.Rows.Count, 1)).EntireRow.Clear
    End With

    With ShDonnees
        DerniereLigneDonnees = DerniereLigneSource
        DerniereColonneDonnees = .Cells(1, .Columns.Count).End(xlToLeft).Column
        .Range(.Cells(2, 1), .Cells(2, DerniereColonneDonnees)).Copy
        With .Range(.Cells(2, 1), .Cells(DerniereLigneDonnees, DerniereColonneDonnees))
             .PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
             .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End With
        .Range(.Cells(DerniereLigneDonnees + 1, 1), .Cells(.Rows.Count, 1)).EntireRow.Clear
    End With

    GoTo Fin

Fin:

    Set ShSource = Nothing: Set ShFormules = Nothing: Set ShDonnees = Nothing

    With Application
         .ScreenUpdating = True
         .Calculation = xlCalculationAutomatic
    End With

    HeureFin = Timer
    TempsTotal = HeureFin - HeureDebut
    MsgBox "Temps total : " & Round(TempsTotal, 0) & " seconde(s)"

End Sub

Bonsoir le fil, bonsoir le forum,

Pas sûr d'avoir compris... Une autre proposition :

Sub Macro1()
Dim ODS As Worksheet 'déclare la variable ODS (Onglet Données Source)
Dim OF As Worksheet 'déclare la variable OF (Onglet Formules)
Dim ODM As Worksheet 'déclare la variable ODM (Onglet Données Modifiées)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Integer 'déclare la variable NL (Nombre de Lignes)
Dim NC As Integer 'déclare la variable NC (Nombre de Colonnes)
Dim J As Integer 'déclare la variable J (incrément)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Application.Calculation = xlCalculationManual 'mode de calcul manuel
Set ODS = Worksheets("Donnes sources") 'définit l'onglet ODS
Set OF = Worksheets("Formules") 'définit l'onglet OF
Set ODM = Worksheets("Données modifiées") 'définit l'onglet ODM
TV = ODS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
OF.Rows("3:" & Application.Rows.Count).Delete 'efface les lignes 3 à la dernière ligne de l'onglet OF
ODM.Rows("3:" & Application.Rows.Count).Delete 'efface les lignes 3 à la dernière ligne de l'onglet ODM
For J = 2 To NC 'boucle sur toutes les colonne J du tableau des valeurs TV (en partant de la seconde)
   'recopie la formule de cellule ligne 2 jusqu'à la ligne NC de la colonne J l'onglet OF
   OF.Cells(2, J).AutoFill Destination:=OF.Range(OF.Cells(2, J), OF.Cells(NL, J))
   'recopie la formule de cellule ligne 2 jusqu'à la ligne NC de la colonne J l'onglet ODM
   ODM.Cells(2, J).AutoFill Destination:=ODM.Range(ODM.Cells(2, J), ODM.Cells(NL, J))
Next J 'prochaine colonne de la boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
Application.Calculation = xlCalculationAutomatic 'mode de calcul automatique
End Sub

Bonsoir

Et une autre proposition

5macro-yal-v3.zip (89.47 Ko)
Rechercher des sujets similaires à "vba macro permettant ajuster onglet rapport donnees sources"