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.
Je ne sait pas si je me suis bien fait comprendre^^.
Merci pour vos réponses
- Messages
- 1'278
- Excel
- 2010 et 365 FR
- Inscrit
- 17.01.2022
- Emploi
- Auto entrepreneur
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