Optimisation de macro

Version imprimable

Bonjour à tous,

Cela fait quelques jours que je cherche à amélioré la rapidité de ma macro mais sans succès.

Le but recherché est de copier certaines colonnes de la 2eme feuille sur la 1ere
Mais au vue du temps nécessaire à l'exécution de la macro je pense qu'excel n'apprécie pas vraiment mon improvisation.
Code:

1 2 3 4 5 6 7 8 9 10 Sub actualiser() Worksheets("Feuil1").Columns("b").Value = Worksheets("Feuil2").Columns("z").Value Worksheets("Feuil1").Columns("c").Value = Worksheets("Feuil2").Columns("a").Value Worksheets("Feuil1").Columns("d").Value = Worksheets("Feuil2").Columns("f").Value Worksheets("Feuil1").Columns("e").Value = Worksheets("Feuil2").Columns("c").Value Worksheets("Feuil1").Columns("f").Value = Worksheets("Feuil2").Columns("o").Value Worksheets("Feuil1").Columns("g").Value = Worksheets("Feuil2").Columns("aa").Value Worksheets("Feuil1").Columns("h").Value = Worksheets("Feuil2").Columns("m").Value End Sub
Je vous remercie d'avance pour les solutions apporté à mon problème.
Cordialement,

Bonjour,

Essaies :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub actualiser()
Dim w1 As Worksheet
Dim w2 As Worksheet
Dim r1 As Range
Dim r2 As Range
  Set w2 = Worksheets("Feuil1")
  Set r2 = w2.UsedRange
  Set w1 = Worksheets("Feuil1")
  Set r1 = w1.Range(r2.Address)
  Intersect(r1, w1.Columns("b")).Value = Intersect(r2, w2.Columns("z")).Value
  Intersect(r1, w1.Columns("c")).Value = Intersect(r2, w2.Columns("a")).Value
  Intersect(r1, w1.Columns("d")).Value = Intersect(r2, w2.Columns("f")).Value
  Intersect(r1, w1.Columns("e")).Value = Intersect(r2, w2.Columns("c")).Value
  Intersect(r1, w1.Columns("f")).Value = Intersect(r2, w2.Columns("o")).Value
  Intersect(r1, w1.Columns("g")).Value = Intersect(r2, w2.Columns("aa")).Value
  Intersect(r1, w1.Columns("h")).Value = Intersect(r2, w2.Columns("m")).Value
End Sub

Bonjour !

Citation:

Envoyé par Zarik1888

Mais au vue du temps nécessaire à l'exécution de la macro

C'est sûr qu'Excel n'apprécie pas de copier plus d'un million de lignes par colonne …
Surtout si la plupart de ces lignes sont vides, quel dommage !
Code:

1 2 3 4 5 6 Sub actualiser() With Feuil2.UsedRange.Rows VA = Application.Index(.Value, Evaluate("ROW(1:" & .Count & ")"), [{26,1,6,3,15,27,13}]) End With Feuil1.Cells(2).Resize(UBound(VA), UBound(VA, 2)).Value = VA End Sub
_________________________________________________________________________________________________________

Merci de cliquer sur :plusser: pour chaque message ayant aidé puis sur :resolu: pour clore cette discussion …

_________________________________________________________________________________________________________
Je suis Paris, Nice, Bruxelles, Charlie, …

Autre solution envisageable :mrgreen: :

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub actualiser()
 
With Worksheets("Feuil2")
    For i = 2 To 8 'de ta colonne 2 à la colonne 8
    y = Split(.Columns(i).Address(ColumnAbsolute:=False), ":")(1) 'récupère la lettre de la colonne
    x = .Range(y & Rows.Count).End(xlUp).Row 'récupère la dernière ligne avec des valeurs de cette colonne
    Worksheets("Feuil1").Range(y & "1:" & y & x).Value = Worksheets("Feuil2").Range(y & "1:" & y & x).Value 'copie les données
    Next i 'colonne suivante
End With
 
End Sub

27/07/2016, 10h35
Stanler
Citation:

Envoyé par Marc-L

Surtout si la plupart de ces lignes sont vides, quel dommage !

Pourrai t on adapter quelque chose comme :
Code:

1 2 3 4 If Worksheets("Feuil2").Columns("z").Value <>"" Then Worksheets("Feuil1").Columns("b").Value = Worksheets("Feuil2").Columns("z").Value Else End If
27/07/2016, 10h40
Al__22
Citation:
Envoyé par Stanler

Pourrai t on adapter quelque chose comme :

Code:

1 2 3 4 If Worksheets("Feuil2").Columns("z").Value <>"" Then Worksheets("Feuil1").Columns("b").Value = Worksheets("Feuil2").Columns("z").Value Else End If
La tu vérifie juste si toute la colonne n'est pas vide et non les lignes vides de cette colonne
28/07/2016, 11h07
Zarik1888

Les solutions que vous m'avez apporté ont grandement optimisé la macro, ça n'a rien à voir avec mon bricolage.

Je vous remercie pour votre rapidité et votre disponibilité !

Cordialement,