code à raccourcir

[netten]

Bonjout tout le monde,

J'ai un code extrêmement répétitif et j'aimerais le réduire, il s'agit de la fonction if elseif else ifend.

Pas d'insultes, c'ets vraiment très grand, merci beaucoups

(je mets juste une partie, parcqu'il y a 5400 lignes)

If Worksheets("Feuil3").Range("IN21") = Worksheets("Feuil3").Range("A41") Then

Worksheets("Feuil3").Range("IL21").Copy

lig = 1

Do While Worksheets("Feuil3").Range("A351").Cells(lig, 1) <> ""
lig = lig + 1

Loop

Worksheets("Feuil3").Range("A" & lig + 350).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


Range("IL21").Select
Selection.ClearContents

Range("IL23").Select

ElseIf Worksheets("Feuil3").Range("IN21") = Worksheets("Feuil3").Range("A42") Then

Worksheets("Feuil3").Range("IL21").Copy

lig = 1

Do While Worksheets("Feuil3").Range("B351").Cells(lig, 1) <> ""
lig = lig + 1

Loop

Worksheets("Feuil3").Range("B" & lig + 350).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


Range("IL21").Select
Selection.ClearContents

Range("IL23").Select

ElseIf Worksheets("Feuil3").Range("IN21") = Worksheets("Feuil3").Range("A43") Then

Worksheets("Feuil3").Range("IL21").Copy

lig = 1

Do While Worksheets("Feuil3").Range("C351").Cells(lig, 1) <> ""
lig = lig + 1

Loop

Worksheets("Feuil3").Range("C" & lig + 350).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


Range("IL21").Select
Selection.ClearContents

Range("IL23").Select

ElseIf Worksheets("Feuil3").Range("IN21") = Worksheets("Feuil3").Range("A44") Then

Worksheets("Feuil3").Range("IL21").Copy

lig = 1

Do While Worksheets("Feuil3").Range("D351").Cells(lig, 1) <> ""
lig = lig + 1

Loop

Worksheets("Feuil3").Range("D" & lig + 350).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


Range("IL21").Select
Selection.ClearContents

Range("IL23").Select


ElseIf Worksheets("Feuil3").Range("IN21") = Worksheets("Feuil3").Range("A45") Then

Worksheets("Feuil3").Range("IL21").Copy

lig = 1

Do While Worksheets("Feuil3").Range("E351").Cells(lig, 1) <> ""
lig = lig + 1

Loop

Worksheets("Feuil3").Range("E" & lig + 350).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


Range("IL21").Select
Selection.ClearContents

Range("IL23").Select


ElseIf Worksheets("Feuil3").Range("IN21") = Worksheets("Feuil3").Range("A46") Then

Worksheets("Feuil3").Range("IL21").Copy

lig = 1

Do While Worksheets("Feuil3").Range("F351").Cells(lig, 1) <> ""
lig = lig + 1

Loop

Worksheets("Feuil3").Range("F" & lig + 350).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


Range("IL21").Select
Selection.ClearContents

Range("IL23").Select


ElseIf Worksheets("Feuil3").Range("IN21") = Worksheets("Feuil3").Range("A47") Then

Worksheets("Feuil3").Range("IL21").Copy

lig = 1

Do While Worksheets("Feuil3").Range("G351").Cells(lig, 1) <> ""
lig = lig + 1

Loop

Worksheets("Feuil3").Range("G" & lig + 350).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


Range("IL21").Select
Selection.ClearContents

Range("IL23").Select


(répété x fois en changeant A41, A42, A43, A44, A45, A46, A47 PAR B41 --> A47, C41 --> C47 .... Comme ça jusqu'à AJ47)


L'ensemble du code se termine par :

Else

Range("IL21").Select


End If

End Sub




En rouge, ce sont les seules valeurs qui sont modifiées.

Merci de votre aide, parce que je n'ai pas vraiment d'idées sur la façon dont je peux réduire tout ce bazarre sachant qu'il me dit que c'est trop grand. Et donc ça ne marche pas.

Vous faut-il d'autres éléments ?
Merci

 

[Guest]

Re : code à raccourcir

bonjour,


Déjà en remplaçant les if elseif par des

[COLOR=BLUE]Sub[/COLOR] t()
    [COLOR=BLUE]With[/COLOR] Worksheets([i]"Feuil3"[/i])
        [COLOR=BLUE]Select[/COLOR] [COLOR=BLUE]Case[/COLOR] .Range([i]"IN21"[/i])
        [COLOR=BLUE]Case[/COLOR] .Range([i]"A46"[/i])
            [COLOR=GREEN]'Traitement A46[/COLOR]
        [COLOR=BLUE]Case[/COLOR] .Range([i]"A42"[/i])
            [COLOR=GREEN]'Traitement A42[/COLOR]
            [COLOR=GREEN]'.....[/COLOR]
        [COLOR=BLUE]End[/COLOR] [COLOR=BLUE]Select[/COLOR]
    [COLOR=BLUE]End[/COLOR] [COLOR=BLUE]With[/COLOR]
[COLOR=BLUE]End[/COLOR] [COLOR=BLUE]Sub[/COLOR]

Voir l'aide excel pour la synthaxe.

Pour le reste et pour ne pas dire de bêtise, il faudrait voir à quoi tout cela correspond exactement. Notament la recherche des cellules vide (peut-être une fonction indépendate?).

A+