Accélerer macro Formulaire de saisie

Bonjour à tous,

j'ai créé un formulaire de saisie sans vba qui remplie d'autres fichiers excels. Le remplissage d'un seul fichier est déjà très long, j'ai utilisé différentes méthodes pour accélérer le processus mais ça ne fonctionne pas très bien.

Auriez-vous des conseils quand à l'écriture du code ? Il y a en effet beaucoup de select (ce qui ralenti ma macro il me semble) puisque je fais des copier/coller de cellules de manière itérative. Il me semble qu'il n'est pas possible de sélectionner l'ensemble des cellules dans un seul select puis de les coller puisque l'agencement n'est pas le même...

Merci pour votre aide.

Bonjour,

En effet : l'utilisation des .select ne se fait que dans de rares cas ! Pareil pour les .activate.

• Première piste d'amélioration :

Renseigne toi premièrement sur la méthode Unionde VBA.

Ensuite, tu peux copier aisément des plages de cellules de cette manière :

'Déclaration des variables
Dim CopyRange As Range
Dim PasteRange As Range

'Attributions de la range à copier et de la range réceptrice
Set CopyRange = WorkBook("REX FORMULAIRE.xlsm").Worksheets("Feuil1").Range(XXXX)
Set PasteRange = WorkBook("LOTGO.xlsm").Worksheets("BDD").Range(XXXX)

'Copie/colle
PasteRange.Value2 = CopyRange.Value2

'Vide les variables objets - Allège la mémoire
Set CopyRange = Nothing
Set PasteRange = Nothing

En adaptant ce code + la méthode Union, tu devrais pouvoir arriver à tes fins...

Bonne soirée,

Baboutz

EDIT : Attention, CopyRange et PasteRange doivent avoir la même dimension (=taille).

Bonjour,

merci de ta réponse, j'ai donc tenté d'utiliser la méthode union pour voir si elle permettait de copier des cellules distinctes et les coller à l'emplacement souhaité :

Sub MacroTESTUNION()

Dim CopyRange As Range
Dim PasteRange As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim Chemin As String, NomFichier As String
Chemin = "D:\PFE TMH\BDD\REX LOTS\"
NomFichier = "LOTGO.xlsm"
Workbooks.Open Filename:=Chemin & NomFichier

'Nouvelle ligne
'Windows("LOTGO.xlsm").Activate
'Rows("5:5").RowHeight = 15.75
'Range("B6").Select
'ActiveSheet.ListObjects("BDD").ShowHeaders = True
'Rows("5:5").RowHeight = 30.75
'Rows("6:6").Select
'Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

'Attributions de la range à copier et de la range réceptrice
Windows("REX FORMULAIRE.xlsm").Activate
Set CopyRange = Workbooks("REX FORMULAIRE.xlsm").Worksheets("Feuil1").Union(Range("G5"), Range("K5"), Range("S5"), Range("O5"), Range("K11"), Range("O11"), Range("S11"), Range("G11"))
Windows("LOTGO.xlsm").Activate
Set PasteRange = Workbooks("LOTGO.xlsm").Worksheets("BDD").Union(Range("A6"), Range("B6"), Range("C6"), Range("D6"), Range("E6"), Range("F6"), Range("G6"), Range("H6"))

PasteRange.Value2 = CopyRange.Value2

'Vide les variables objets - Allège la mémoire
Set CopyRange = Nothing
Set PasteRange = Nothing

'Fermeture en tête
'ActiveSheet.ListObjects("BDD").ShowHeaders = True
'Rows("5:5").Select
'Selection.RowHeight = 2.25

'Fermer et Sauvergarder
'Workbooks("LOTGO.xlsm").Close SaveChanges:=True
End Sub

J'obtiens l'erreur " Propriété ou Méthode non gérée par cet objet" pour le SetCopyRange...

Salut,

Tu étais pas loin ! Mais même avec la bonne écriture, cela ne fonctionne pas après tests chez moi, voilà donc une méthode légèrement différente :

Dim CopyRange As Range
Dim i As Range
Dim j As Byte

With Workbooks("rex-formulaire.xlsm").Worksheets("Feuil1")
    Set CopyRange = Union(.Range("G5"), .Range("K5"), .Range("S5"), .Range("O5"), .Range("K11"), .Range("O11"), .Range("S11"), .Range("G11"), .Range("V5"))
End With

j = 1

For Each i In CopyRange: Workbooks("lotgo.xlsm").Worksheets("BDD").Cells(6, j) = i.Value: j = j + 1: Next i

Set CopyRange = Nothing

Merci pour ta réponse,

j'ai finalement juste mis en place des attributions les unes après les autres en utilisant ton code ! Mon code est donc très moche mais fonctionne bien et répond parfaitement à ma problématique de lenteur... Si jamais j'ai le temps je tenterai de le rendre plus classe

Bonne journée