reduire code

B

BIL boud

XLDnaute Occasionnel
Bonjour

j'ai mis un code qui recupere des données dans un autre classeur et ca marche bien sauf que il est long, est il possible de le reduire svp ?

VOICI LE CODE


VB: 
Sub macro1()
b = Worksheets("NEW_VB_config").Range("o2")
c = Worksheets("NEW_VB_config").Range("o3")
d = Worksheets("NEW_VB_config").Range("o4")
g = Worksheets("NEW_VB_config").Range("o5")
h = Worksheets("NEW_VB_config").Range("o6")
k = Worksheets("NEW_VB_config").Range("o7")
l = Worksheets("NEW_VB_config").Range("o8")
m = Worksheets("NEW_VB_config").Range("o9")
n = Worksheets("NEW_VB_config").Range("o10")
o = Worksheets("NEW_VB_config").Range("o11")
p = Worksheets("NEW_VB_config").Range("o12")


a = Workbooks("iOMEGA_Equipe_CDO_v4_6_01032019.xlsm").Worksheets("NEW_VB_config").Range("o2:o12") 'nom des 11 feuilles



For f = 1 To 11                 'boucle sur les feuilles
If a(f, 1) <> "" And a(f, 1) = b Then             'feuille o2
derlin = Workbooks("iOMEGA_Equipe_CDO_v4_6_01032019.xlsm").Worksheets(b).Range("a65000").End(xlUp).Row
If derlin <> 1 Then

'test ligne
derliac2 = Workbooks("greogroire essai_V2.xlsm").Worksheets(b).Range("a65000").End(xlUp).Row
For i2 = 2 To derliac2
If Workbooks("greogroire essai_V2.xlsm").Worksheets(b).Cells(i2, 40) = "OMEGA 1" Then
test2 = Workbooks("greogroire essai_V2.xlsm").Worksheets(b).Cells(i2, 40).Row
End If
Next i2

If derlin > test2 Then
n2 = derlin - test2
Workbooks("greogroire essai_V2.xlsm").Worksheets(b).Rows(test2 + 1).Resize(n2).Insert
End If
'fin tets

For i = 2 To derlin
  If Range("a" & i) <> "" And Worksheets(b).Cells(i, 1) <> Workbooks("greogroire essai_V2.xlsm").Worksheets(b).Cells(i, 1) Then
 
   For j = 1 To 6
    Workbooks("greogroire essai_V2.xlsm").Worksheets(b).Cells(i, j) = Worksheets(b).Cells(i, j)
    Next j
    Workbooks("greogroire essai_V2.xlsm").Worksheets(b).Cells(i, 40) = "OMEGA 1"
  End If
  last1 = Workbooks("greogroire essai_V2.xlsm").Worksheets(b).Range("a" & i).Row + 1
Next i
Else
last11 = 2
End If

ElseIf a(f, 1) <> "" And a(f, 1) = c Then          'feuille o3
derlin1 = Workbooks("iOMEGA_Equipe_CDO_v4_6_01032019.xlsm").Worksheets(c).Range("a65000").End(xlUp).Row
If derlin1 <> 1 Then
'test ligne
derliac3 = Workbooks("greogroire essai_V2.xlsm").Worksheets(c).Range("a65000").End(xlUp).Row
For i3 = 2 To derliac3
If Workbooks("greogroire essai_V2.xlsm").Worksheets(c).Cells(i3, 40) = "OMEGA 1" Then
test3 = Workbooks("greogroire essai_V2.xlsm").Worksheets(c).Cells(i3, 40).Row
End If
Next i3

If derlin1 > test3 Then
n3 = derlin1 - test3
Workbooks("greogroire essai_V2.xlsm").Worksheets(c).Rows(test3 + 1).Resize(n3).Insert
End If
'fin tets

For i = 2 To derlin1
  If Range("a" & i) <> "" And Worksheets(c).Cells(i, 1) <> Workbooks("greogroire essai_V2.xlsm").Worksheets(c).Cells(i, 1) Then
   
    For j = 1 To 6
    Workbooks("greogroire essai_V2.xlsm").Worksheets(c).Cells(i, j) = Worksheets(c).Cells(i, j)
    Next j
    Workbooks("greogroire essai_V2.xlsm").Worksheets(c).Cells(i, 40) = "OMEGA 1"
  End If
  last2 = Workbooks("greogroire essai_V2.xlsm").Worksheets(c).Range("a" & i).Row + 1
Next i
Else
last2 = 2
End If



ElseIf a(f, 1) <> "" And a(f, 1) = d Then         'feuille o4
derlin2 = Workbooks("iOMEGA_Equipe_CDO_v4_6_01032019.xlsm").Worksheets(d).Range("a65000").End(xlUp).Row
If derlin2 <> 1 Then
'test ligne
derliac4 = Workbooks("greogroire essai_V2.xlsm").Worksheets(d).Range("a65000").End(xlUp).Row
For i4 = 2 To derliac4
If Workbooks("greogroire essai_V2.xlsm").Worksheets(d).Cells(i4, 40) = "OMEGA 1" Then
test4 = Workbooks("greogroire essai_V2.xlsm").Worksheets(d).Cells(i4, 40).Row
End If
Next i4

If derlin2 > test4 Then
n4 = derlin2 - test4
Workbooks("greogroire essai_V2.xlsm").Worksheets(d).Rows(test4 + 1).Resize(n4).Insert
End If
'fin tets

For i = 2 To derlin2
     If Range("a" & i) <> "" And Worksheets(d).Cells(i, 1) <> Workbooks("greogroire essai_V2.xlsm").Worksheets(d).Cells(i, 1) Then
       
        For j = 1 To 6
        Workbooks("greogroire essai_V2.xlsm").Worksheets(d).Cells(i, j) = Worksheets(d).Cells(i, j)
        Next j
        Workbooks("greogroire essai_V2.xlsm").Worksheets(d).Cells(i, 40) = "OMEGA 1"
      End If
    last3 = Workbooks("greogroire essai_V2.xlsm").Worksheets(d).Range("a" & i).Row + 1
Next i
Else
last3 = 2
End If

ElseIf a(f, 1) <> "" And a(f, 1) = g Then         'feuille o5
derlin3 = Workbooks("iOMEGA_Equipe_CDO_v4_6_01032019.xlsm").Worksheets(g).Range("a65000").End(xlUp).Row
If derlin3 <> 1 Then
'test ligne
derliac5 = Workbooks("greogroire essai_V2.xlsm").Worksheets(g).Range("a65000").End(xlUp).Row
For i5 = 2 To derliac5
If Workbooks("greogroire essai_V2.xlsm").Worksheets(g).Cells(i5, 40) = "OMEGA 1" Then
test5 = Workbooks("greogroire essai_V2.xlsm").Worksheets(g).Cells(i5, 40).Row
End If
Next i5

If derlin3 > test5 Then
n5 = derlin3 - test5
Workbooks("greogroire essai_V2.xlsm").Worksheets(g).Rows(test5 + 1).Resize(n5).Insert
End If
'fin tets
For i = 2 To derlin3
  If Range("a" & i) <> "" And Worksheets(g).Cells(i, 1) <> Workbooks("greogroire essai_V2.xlsm").Worksheets(g).Cells(i, 1) Then
   
    For j = 1 To 6
    Workbooks("greogroire essai_V2.xlsm").Worksheets(g).Cells(i, j) = Worksheets(g).Cells(i, j)
    Next j
    Workbooks("greogroire essai_V2.xlsm").Worksheets(g).Cells(i, 40) = "OMEGA 1"
  End If
  last4 = Workbooks("greogroire essai_V2.xlsm").Worksheets(g).Range("a" & i).Row + 1
Next i
Else
last4 = 2
End If

ElseIf a(f, 1) <> "" And a(f, 1) = h Then         'feuille o6
derlin4 = Workbooks("iOMEGA_Equipe_CDO_v4_6_01032019.xlsm").Worksheets(h).Range("a65000").End(xlUp).Row
If derlin4 <> 1 Then
'test ligne
derliac6 = Workbooks("greogroire essai_V2.xlsm").Worksheets(h).Range("a65000").End(xlUp).Row
For i6 = 2 To derliac6
If Workbooks("greogroire essai_V2.xlsm").Worksheets(h).Cells(i6, 40) = "OMEGA 1" Then
test6 = Workbooks("greogroire essai_V2.xlsm").Worksheets(h).Cells(i6, 40).Row
End If
Next i6

If derlin4 > test6 Then
n6 = derlin4 - test6
Workbooks("greogroire essai_V2.xlsm").Worksheets(h).Rows(test6 + 1).Resize(n6).Insert
End If
'fin tets
For i = 2 To derlin4
  If Range("a" & i) <> "" And Worksheets(h).Cells(i, 1) <> Workbooks("greogroire essai_V2.xlsm").Worksheets(h).Cells(i, 1) Then
   
    For j = 1 To 6
    Workbooks("greogroire essai_V2.xlsm").Worksheets(h).Cells(i, j) = Worksheets(h).Cells(i, j)
    Next j
    Workbooks("greogroire essai_V2.xlsm").Worksheets(h).Cells(i, 40) = "OMEGA 1"
  End If
  last5 = Workbooks("greogroire essai_V2.xlsm").Worksheets(h).Range("an" & i).Row + 1
Next i
Else
last5 = 2
End If

ElseIf a(f, 1) <> "" And a(f, 1) = k Then         'feuille o7
derlin5 = Workbooks("iOMEGA_Equipe_CDO_v4_6_01032019.xlsm").Worksheets(k).Range("a65000").End(xlUp).Row
If derlin5 <> 1 Then
'test ligne
derliac7 = Workbooks("greogroire essai_V2.xlsm").Worksheets(k).Range("a65000").End(xlUp).Row
For i7 = 2 To derliac7
If Workbooks("greogroire essai_V2.xlsm").Worksheets(k).Cells(i7, 40) = "OMEGA 1" Then
test7 = Workbooks("greogroire essai_V2.xlsm").Worksheets(k).Cells(i7, 40).Row
End If
Next i7

If derlin5 > test7 Then
n7 = derlin5 - test7
Workbooks("greogroire essai_V2.xlsm").Worksheets(k).Rows(test7 + 1).Resize(n7).Insert
End If
'fin tets
For i = 2 To derlin5
  If Range("a" & i) <> "" And Worksheets(k).Cells(i, 1) <> Workbooks("greogroire essai_V2.xlsm").Worksheets(k).Cells(i, 1) Then
 
    For j = 1 To 6
    Workbooks("greogroire essai_V2.xlsm").Worksheets(k).Cells(i, j) = Worksheets(k).Cells(i, j)
    Next j
     Workbooks("greogroire essai_V2.xlsm").Worksheets(k).Cells(i, 40) = "OMEGA 1"
  End If
  last6 = Workbooks("greogroire essai_V2.xlsm").Worksheets(k).Range("a" & i).Row + 1
Next i
Else
last6 = 2
End If

ElseIf a(f, 1) <> "" And a(f, 1) = l Then         'feuille o8
derlin6 = Workbooks("iOMEGA_Equipe_CDO_v4_6_01032019.xlsm").Worksheets(l).Range("a65000").End(xlUp).Row
If derlin6 <> 1 Then
'test ligne
derliac8 = Workbooks("greogroire essai_V2.xlsm").Worksheets(l).Range("a65000").End(xlUp).Row
For i8 = 2 To derliac8
If Workbooks("greogroire essai_V2.xlsm").Worksheets(l).Cells(i8, 40) = "OMEGA 1" Then
test8 = Workbooks("greogroire essai_V2.xlsm").Worksheets(l).Cells(i8, 40).Row
End If
Next i8

If derlin6 > test8 Then
n8 = derlin6 - test8
Workbooks("greogroire essai_V2.xlsm").Worksheets(l).Rows(test8 + 1).Resize(n8).Insert
End If
'fin tets

For i = 2 To derlin6
  If Range("a" & i) <> "" And Worksheets(l).Cells(i, 1) <> Workbooks("greogroire essai_V2.xlsm").Worksheets(l).Cells(i, 1) Then
   
    For j = 1 To 6
    Workbooks("greogroire essai_V2.xlsm").Worksheets(l).Cells(i, j) = Worksheets(l).Cells(i, j)
    Next j
    Workbooks("greogroire essai_V2.xlsm").Worksheets(l).Cells(i, 40) = "OMEGA 1"
  End If
  last7 = Workbooks("greogroire essai_V2.xlsm").Worksheets(l).Range("a" & i).Row + 1
Next i
Else
last7 = 2
End If

ElseIf a(f, 1) <> "" And a(f, 1) = m Then         'feuille o9
derlin7 = Workbooks("iOMEGA_Equipe_CDO_v4_6_01032019.xlsm").Worksheets(m).Range("a65000").End(xlUp).Row
If derlin7 <> 1 Then

'test ligne
derliac9 = Workbooks("greogroire essai_V2.xlsm").Worksheets(m).Range("a65000").End(xlUp).Row
For i9 = 2 To derliac9
If Workbooks("greogroire essai_V2.xlsm").Worksheets(m).Cells(i9, 40) = "OMEGA 1" Then
test9 = Workbooks("greogroire essai_V2.xlsm").Worksheets(m).Cells(i9, 40).Row
End If
Next i9

If derlin7 > test9 Then
n9 = derlin7 - test9
Workbooks("greogroire essai_V2.xlsm").Worksheets(m).Rows(test9 + 1).Resize(n9).Insert
End If
'fin tets

For i = 2 To derlin7
  If Range("a" & i) <> "" And Worksheets(m).Cells(i, 1) <> Workbooks("greogroire essai_V2.xlsm").Worksheets(m).Cells(i, 1) Then
   
    For j = 1 To 6
    Workbooks("greogroire essai_V2.xlsm").Worksheets(m).Cells(i, j) = Worksheets(m).Cells(i, j)
    Next j
    Workbooks("greogroire essai_V2.xlsm").Worksheets(m).Cells(i, 40) = "OMEGA 1"
  End If
  last8 = Workbooks("greogroire essai_V2.xlsm").Worksheets(m).Range("a" & i).Row + 1
Next i
Else
last8 = 2
End If

ElseIf a(f, 1) <> "" And a(f, 1) = n Then         'feuille o10
derlin8 = Workbooks("iOMEGA_Equipe_CDO_v4_6_01032019.xlsm").Worksheets(n).Range("a65000").End(xlUp).Row
If derlin8 <> 1 Then
'test ligne
derliac10 = Workbooks("greogroire essai_V2.xlsm").Worksheets(n).Range("a65000").End(xlUp).Row
For i10 = 2 To derliac10
If Workbooks("greogroire essai_V2.xlsm").Worksheets(n).Cells(i10, 40) = "OMEGA 1" Then
test10 = Workbooks("greogroire essai_V2.xlsm").Worksheets(n).Cells(i10, 40).Row
End If
Next i10

If derlin8 > test10 Then
n10 = derlin8 - test10
Workbooks("greogroire essai_V2.xlsm").Worksheets(n).Rows(test10 + 1).Resize(n10).Insert
End If
'fin tets
For i = 2 To derlin8
  If Range("a" & i) <> "" And Worksheets(n).Cells(i, 1) <> Workbooks("greogroire essai_V2.xlsm").Worksheets(n).Cells(i, 1) Then
   
    For j = 1 To 6
    Workbooks("greogroire essai_V2.xlsm").Worksheets(n).Cells(i, j) = Worksheets(m).Cells(i, j)
    Next j
    Workbooks("greogroire essai_V2.xlsm").Worksheets(n).Cells(i, 40) = "OMEGA 1"
  End If
  last9 = Workbooks("greogroire essai_V2.xlsm").Worksheets(n).Range("a" & i).Row + 1
Next i
Else
last9 = 2
End If

ElseIf a(f, 1) <> "" And a(f, 1) = o Then         'feuille o11
derlin9 = Workbooks("iOMEGA_Equipe_CDO_v4_6_01032019.xlsm").Worksheets(o).Range("a65000").End(xlUp).Row
If derlin9 <> 1 Then
'test ligne
derliac11 = Workbooks("greogroire essai_V2.xlsm").Worksheets(o).Range("a65000").End(xlUp).Row
For i11 = 2 To derliac11
If Workbooks("greogroire essai_V2.xlsm").Worksheets(o).Cells(i11, 40) = "OMEGA 1" Then
test11 = Workbooks("greogroire essai_V2.xlsm").Worksheets(o).Cells(i11, 40).Row
End If
Next i11

If derlin9 > test11 Then
n11 = derlin9 - test11
Workbooks("greogroire essai_V2.xlsm").Worksheets(o).Rows(test11 + 1).Resize(n11).Insert
End If
'fin tets
For i = 2 To derlin9
  If Range("a" & i) <> "" And Worksheets(o).Cells(i, 1) <> Workbooks("greogroire essai_V2.xlsm").Worksheets(o).Cells(i, 1) Then
 
    For j = 1 To 6
    Workbooks("greogroire essai_V2.xlsm").Worksheets(o).Cells(i, j) = Worksheets(o).Cells(i, j)
    Next j
     Workbooks("greogroire essai_V2.xlsm").Worksheets(o).Cells(i, 40) = "OMEGA 1"
  End If
  last10 = Workbooks("greogroire essai_V2.xlsm").Worksheets(o).Range("a" & i).Row + 1
Next i
Else
last10 = 2
End If

ElseIf a(f, 1) <> "" And a(f, 1) = p Then         'feuille o12
derlin10 = Workbooks("iOMEGA_Equipe_CDO_v4_6_01032019.xlsm").Worksheets(p).Range("a65000").End(xlUp).Row
If derlin10 <> 1 Then
'test ligne
derliac12 = Workbooks("greogroire essai_V2.xlsm").Worksheets(p).Range("a65000").End(xlUp).Row
For i12 = 2 To derliac12
If Workbooks("greogroire essai_V2.xlsm").Worksheets(p).Cells(i12, 40) = "OMEGA 1" Then
test12 = Workbooks("greogroire essai_V2.xlsm").Worksheets(p).Cells(i12, 40).Row
End If
Next i12

If derlin10 > test12 Then
n12 = derlin10 - test12
Workbooks("greogroire essai_V2.xlsm").Worksheets(p).Rows(test12 + 1).Resize(n12).Insert
End If
'fin tets
For i = 2 To derlin10
  If Range("a" & i) <> "" And Worksheets(p).Cells(i, 1) <> Workbooks("greogroire essai_V2.xlsm").Worksheets(p).Cells(i, 1) Then
 
    For j = 1 To 6
    Workbooks("greogroire essai_V2.xlsm").Worksheets(p).Cells(i, j) = Worksheets(p).Cells(i, j)
    Next j
     Workbooks("greogroire essai_V2.xlsm").Worksheets(p).Cells(i, 40) = "OMEGA 1"
  End If
  last11 = Workbooks("greogroire essai_V2.xlsm").Worksheets(p).Range("a" & i).Row + 1
Next i
Else
last11 = 2
End If

End If
Next
MsgBox "Omega 1 terminé"
end sub

merci d'avance
 
Dernière édition:
Trier par date Trier par votes
Paf

Paf

XLDnaute Barbatruc
Bonjour,

Pas facile de lire ce long code non indenté à rebondissements de if else elseif imbriqués.

Si vous expliquiez ce que vous voulez faire ?

A+

Edit : Il est long en nombre de ligne ou en durée de traitement ?
 
Vote positif 0 Vote négatif
B

BIL boud

XLDnaute Occasionnel
Paf à dit:
Bonjour,

Pas facile de lire ce long code non indenté à rebondissements de if else elseif imbriqués.

Si vous expliquiez ce que vous voulez faire ?

A+

Edit : Il est long en nombre de ligne ou en durée de traitement ?
Cliquez pour agrandir...

bonjour

en faite je souhaite récupérer des données dans un autre classeur "iOMEGA_Equipe_CDO_v4_6_01032019.xlsm" que jai nommé (a), ce dernier contient plusieurs feuilles (11 feuilles que j'ai indique dans mon code par les lettres : b/c/d/g/h/k/l/m/n/o/p ), du coup je dois recuperer les donnée de chaque feuilles de classeur (a) et les collers dans des feuilles qui contiennent mm nom dans mon classeur ( c pour ca jai mis cette condition
VB: 
If a(f, 1) <> "" And a(f, 1) = b
)
Code: 
For i = 2 To derlin
  If Range("a" & i) <> "" And Worksheets(b).Cells(i, 1) <> Workbooks("greogroire essai_V2.xlsm").Worksheets(b).Cells(i, 1) Then
  
   For j = 1 To 6
    Workbooks("greogroire essai_V2.xlsm").Worksheets(b).Cells(i, j) = Worksheets(b).Cells(i, j)
    Next j
    Workbooks("greogroire essai_V2.xlsm").Worksheets(b).Cells(i, 40) = "OMEGA 1"
  End If
  last1 = Workbooks("greogroire essai_V2.xlsm").Worksheets(b).Range("a" & i).Row + 1
Next i
Else
last1 = 2
End If

pour faire la mise a jour rapidement,quand je clique sur mon bouton je ne veux pas recuperer les donnes qui ne sont pas modifiees (si range("a" & i) nest pas modifie je ne vais pas faire copier coller du coup j évite lextraction de cette ligne ==>la macro est rapide dasn ce cas)
si ils ont rajouter des lignes dans le classeur a : je crée dans mon classeur le mm nombre de lignes rajoutées dans le classeur
Code: 
'test ligne
derliac2 = Workbooks("greogroire essai_V2.xlsm").Worksheets(b).Range("a65000").End(xlUp).Row
For i2 = 2 To derliac2
If Workbooks("greogroire essai_V2.xlsm").Worksheets(b).Cells(i2, 40) = "OMEGA 1" Then
test2 = Workbooks("greogroire essai_V2.xlsm").Worksheets(b).Cells(i2, 40).Row
End If
Next i2

If derlin > test2 Then
n2 = derlin - test2
Workbooks("greogroire essai_V2.xlsm").Worksheets(b).Rows(test2 + 1).Resize(n2).Insert
End If
'fin tets

voila c aue le code fait generalement

jespere que vous avez compris ce que je voulais faire

ps: je dois extraire es donnée de 5 classeurs differents , c pour cela je dois essayer de reduire le code pour eviter "erreur "procedure tres grande"

merci davance
 
Vote positif 0 Vote négatif

Discussions similaires

L
  • Question
VBA : erreur sur boucle
Réponses
2
Affichages
63
Latias
L
T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
896
thivame
T
A
  • Question
XL 2019 Vérifier si une ligne existe dans un autre fichier
Réponses
7
Affichages
447
A-F
A
M
  • Résolu(e)
XL 2016 Amélioration de code
Réponses
3
Affichages
344
M@xu3L
M
G
  • Question
Microsoft 365 Saut de ligne dans une cellule
Réponses
3
Affichages
126
GClaire
G
FRYS
  • Question
Microsoft 365 Retrouver les dépendants de cellules nommées
Réponses
6
Affichages
202
crocrocro
C
B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
203
Compte Supprimé 979
C
Y
  • Question
Microsoft 365 Insérer des lignes selon variable
Réponses
1
Affichages
223
gbinforme
G
L
  • Résolu(e)
Microsoft 365 Suppression de cellules vide
Réponses
3
Affichages
167
Le Rouky
L
F
  • Résolu(e)
XL 2021 fermeture du classeur après apple d'un userform d'un autre classeur ouvert
Réponses
2
Affichages
87
farid
F

Membres actuellement en ligne

17 membres et 145 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 109
Messages
2 085 381
Membres
102 876
dernier inscrit
BouteilleMan