Discussion :

[laduche31]

Bonjour à tous!

J'ai une macro qui fonctionne bien mais est beaucoup trop longue.. (environ 12 secondes)

Ce que je cherche à faire:
1 - Enlever les filtres actifs (sans les supprimer)
2 - Insérer une ligne à la fin du tableau qui recopie les formules de la ligne du dessus
3 - Insérer la valeur "31.12.2020" en colonne 296,
4 - Se positionner sur la colonne 2

Voici mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Bouton9_Clic()
 
On Error Resume Next
Sheets("Feuil1").ShowAllData
On Error GoTo 0
 
 
  Range("A2").Select 'la première cellule de la ligne de titre
  Selection.End(xlDown).Select 'la dernière cellule de la colonne A avant la cellule vide
  Selection.EntireRow.Copy
  Selection.Insert shiftXldown
  Selection.Offset(1).Select  'positionnement sur la nouvelle ligne
  For Each c In Intersect(ActiveSheet.UsedRange, Selection.EntireRow)
    If Left(c.Formula, 1) <> "=" Then c.Value = ""
  Next
  Selection = Selection.Offset(-1) + 1  ' incrémentation de la valeur en colonne A
 
Application.CutCopyMode = False
Selection.Offset(0, 296).Select 
Selection.Value = "31.12.2020" 
Selection.Offset(0, -295).Select
 
End Sub

Voilà si vous avez des idées je suis preneur! Merci

Adrien

[mercatog]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Bouton9_Clic()
Dim LastLig As Long
Dim c As Range
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Worksheets("Feuil1")
    If .FilterMode Then .ShowAllData
    Set c = .UsedRange.Find("*", , , , xlByColumns, xlPrevious)
    If Not c Is Nothing Then
        LastLig = c.Row
        Set c = Nothing
        .Rows(LastLig).Copy .Range("A" & LastLig + 1)
        .Rows(LastLig + 1).SpecialCells(xlConstants).ClearContents
        .Cells(LastLig + 1, 296) = "31.12.2020"
    End If
End With
Application.Calculation = xlCalculationAutomatic
End Sub

[defluc]

Adresses directement les cellules plutôt qu'utiliser des sélections.
ActiveSheet.Cells(Row, Col)
En première instruction, places

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.ScreenUpdating = False

et rétablis cette valeur à True en fin de processus.

L'exécution se fera un un clin d'oeil.

[laduche31]

Bonjour à vous et tout d'abord merci pour votre aide!

Mercatog votre code ne fonctionne pas, je n'ai pas d'erreurs mais rien ne se passe en fait.

defluc j'ai ajouté les instructions

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.ScreenUpdating = False

puis true en fin avec succès.

Cependant je n'ai pas réussi à transcrire les Selection par ActiveSheet.Cells(0, 299) = "31.12.2020"
Ca me met une erreur.

Adrien.

[mercatog]

laduche31, mon code fonctionne (à moins si tu ne l'as pas adapté).

Dans ton éditeur vba, fais une exécution pas à pas, à l'aide de F8 et regarde ce qui se passe.

[laduche31]

Ok je regarde à nouveau et je te redis

Merci,

Adrien

EDIT : J'ai compris pourquoi ça ne "marchait pas". En fait plus bas j'ai un deuxième tableau donc la ligne va s'insérer en bas du deuxième tableau.
Je cherche à insérer en fin de 1er tableau, pardon de ne pas avoir précisé.
Serait-il également possible d'incrémenter la valeur en colonne A?
(J'ai des chiffres en colonne A : 127,128,...)

En tout cas niveau rapidité c'est parfait!

Merci!

[mercatog]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Bouton9_Clic()
Dim LastLig As Long
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Worksheets("Feuil1")
    If .FilterMode Then .ShowAllData
    LastLig = .Range("A2").CurrentRegion.Rows.Count + 1
    Set c = Nothing
    .Rows(LastLig).Copy
    .Rows(LastLig + 1).Insert
    Application.CutCopyMode = False
    .Rows(LastLig + 1).SpecialCells(xlConstants).ClearContents
    .Cells(LastLig + 1, 296) = "31.12.2020"
    .Cells(LastLig + 1, 1) = Val(.Cells(LastLig, 1)) + 1
End With
Application.Calculation = xlCalculationAutomatic
End Sub