Incrémentation formule

[head_tatty]

Bonsoir à tous,

J' ai une formule macro dans une cellule sur une feuille excel. La voici :

Sheets("A").Select
    Range("[COLOR="red"]A1[/COLOR]:[COLOR="Red"]B1[/COLOR]").Select
    Selection.Copy
    Sheets("Feuil1").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("N").Select
    Range("[COLOR="red"]C1[/COLOR]:[COLOR="red"]D1[/COLOR]").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Feuil1").Select
    Range("U1").Select
    ActiveSheet.Paste
    Range("A1").Select
Tableau = Array[COLOR="red"]E1[/COLOR]
For I = 0 To 19
Cells.Replace What:=Tableau(I), Replacement:="", LookAt:=xlWhole, SearchOrder _
    :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=True
Next I
    Sheets("B").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("C").Select
    Range("[COLOR="red"]F1[/COLOR]").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

J' aimerais l' incrémenter de sorte que la première cellule issue de cette incrémentation se présente ainsi ( et donc que seul ce qui est en rouge soit modifié ):

Sheets("A").Select
    Range("[COLOR="red"]A2[/COLOR]:[COLOR="Red"]B2[/COLOR]").Select
    Selection.Copy
    Sheets("Feuil1").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("N").Select
    Range("[COLOR="red"]C2[/COLOR]:[COLOR="red"]D2[/COLOR]").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Feuil1").Select
    Range("U1").Select
    ActiveSheet.Paste
    Range("A1").Select
Tableau = Array[COLOR="red"]E2[/COLOR]
For I = 0 To 19
Cells.Replace What:=Tableau(I), Replacement:="", LookAt:=xlWhole, SearchOrder _
    :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=True
Next I
    Sheets("B").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("C").Select
    Range("[COLOR="red"]F2[/COLOR]").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

puis A3 B3 C3 D3 E3 F3
puis A4 B4 C4 D4 E4 F4
etc...

Voici les données contenues dans chaque cellule :
en A1 : U1
en B1 : V2
en C1 : W3
en D1 : X4
en E1 : ("1950", "1976", "1880", "2500", "1600")
en F1 : Z6

Donc voici ce qui doit apparaitre dans ma première cellule du début :

Sheets("A").Select
    Range("[COLOR="red"]U1[/COLOR]:[COLOR="Red"]V2[/COLOR]").Select
    Selection.Copy
    Sheets("Feuil1").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("N").Select
    Range("[COLOR="red"]W3[/COLOR]:[COLOR="red"]X4[/COLOR]").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Feuil1").Select
    Range("U1").Select
    ActiveSheet.Paste
    Range("A1").Select
Tableau = Array[COLOR="red"]("1950", "1976", "1880", "2500", "1600")
[/COLOR]
For I = 0 To 19
Cells.Replace What:=Tableau(I), Replacement:="", LookAt:=xlWhole, SearchOrder _
    :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=True
Next I
    Sheets("B").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("C").Select
    Range("[COLOR="red"]Z6[/COLOR]").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Cordialement,

 

[head_tatty]

Re : Incrémentation formule

Bonsoir,

Tout d' abord, je te prie de m' excuser, JNP, de n' avoir pas vu plus tôt ton message. Ca ne marche pas.

Je vais faire plus simple avec le fichier joint.

Cordialement,

Regarde la pièce jointe Exemples.xlsx

 

[JNP]

Re : Incrémentation formule

Re 🙂,
C'est pas forcément très clair, mais l'exemple en pièce jointe devrait te convenir.
Limitation, si une feuille se nomme avec 1 à 3 majuscules suivies de 1 à 7 chiffres, elle ne sera jamais sélectionnée car elle sera assimilée à une adresse de cellules 😉...
Bonne journée 😎