Incrémentation formule

H

head_tatty

XLDnaute Nouveau
Bonsoir à tous,

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

Code: 
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é ):

Code: 
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 :

Code: 
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,
 
Dernière édition:
Trier par date Trier par votes
S

Softmama

XLDnaute Accro
Re : Incrémentation formule

Bonsoir,

Alors à la volée, je dirais un truc dans le genre (sous réserve que j'ai tout compris) :

VB: 
Dim Cpteur&, i&
Cpteur = 0
Do while [A1].offset(Cpteur, 0) <> ""
  Range([A1].offset(Cpteur, 0) & ":" & [B1].offset(Cpteur, 0)).Copy Destination:= Sheets("Feuil1").[A1]
  Sheets("N").range([C1].offset(Cpteur, 0) & ":" & [D1].offset(Cpteur, 0)).Copy Destination:=Sheets("Feuil1").[U1]
  Tableau = Array(Sheets(Start).[E1].offset(Cpteur, 0))
  For i = 0 to 19
      Cells.Replace What:=Tableau(i), Replacement:="", LookAt:=xlWhole
  Next i
  Sheets("B").Select
  Selection.Copy 
  Sheets("C").Select
  [F1].offset(Cpteur, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks :=False, Transpose:=False
  Cpteur= Cpteur +1
Loop

Si j'ai tout faux, donne un petit fichier d'exemple qu'on passe pas son temps à tenter de deviner ce que tu souhaites comme résultat :)
 
Vote positif 0 Vote négatif
K

kjin

XLDnaute Barbatruc
Re : Incrémentation formule

Bonsoir,
Plutôt que de fournir un code ni n'a ni queue ni tête, _genre j'incrémente la plage source mais pas celle de destination !_, si tu expliquais clairement ce que tu veux faire, ce serait beaucoup mieux et un fichier est toujours bienvenu
A+
kjin
 
Vote positif 0 Vote négatif
K

kjin

XLDnaute Barbatruc
Re : Incrémentation formule

Bonjour,
Je suis désolé, mais ne vois vraiment pas en quoi le fichier joint apporte une quelconque explication, je dirais même que c'est plutôt le contraire :rolleyes:
Par contre, il aurait été plus judicieux d'indiquer le résultat que la macro devrait renvoyer avec des feuilles qui se nomment "A", "N"...et non pas explication, essai...
A+
kjin
 
Dernière édition:
Vote positif 0 Vote négatif
H

head_tatty

XLDnaute Nouveau
Re : Incrémentation formule

Bonsoir,

Bon, je vais essayer de faire du simple au plus "compliqué".

Je suis dans un classeur excel, dans une feuille nommé Feuil1 ( ce n' est pas très important mais bon).

Dans la cellule A1, je tape, 159 et j' appuis sur Entrée.

Ensuite je vais dans la cellule, pourquoi pas, B1 et je tape =A1 puis j' appuis sur Entrée et là, s' affiche 159 !:eek:

La forme de ma macro n' a pas d' importance, ni son contenu, ni les feuilles qu' elle désigne...Tout ce que je veux c' est que les noms cellules que j' ai mis en rouge soit remplacées par leur contenu en gardant tel quel tout ce que je n' ai pas mis en rouge.

J' ai aussi essayé :

Code: 
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

Mais bien sûr ça n' est pas si facile et donc ça ne marche pas.

Je ne vois vraiment pas un autre moyen, d' autres mots pour expliquer ce que je veux. :(Dites moi peut être ce que vous n' avez pas compris et ce que vous avez compris.

Cordialement,
 
Vote positif 0 Vote négatif
K

kjin

XLDnaute Barbatruc
Re : Incrémentation formule

Re,
Je craque....
Code: 
Range(CStr(Range("A1") & ":" & CStr(Range("B1")))).Select '?????
T = Split(Range("E1"), ",")
For i = LBound(T) To UBound(T)
    Range(T(i) & ":" & T(i)).Select '??????
Next
...et je passe la main à plus motivé
A+
kjin
 
Vote positif 0 Vote négatif
ninbihan

ninbihan

XLDnaute Impliqué
Re : Incrémentation formule

Bonjour à tous,


Un essai avec ce que j'ai pu comprendre :
Code: 
Sheets("A").Select
    Range(range("A1") & ":" & range("B1")).Select
    Selection.Copy
    Sheets("Feuil1").Select
    Range(range("A1")).Select
    ActiveSheet.Paste
    Sheets("N").Select
    Range(range("C1") & ":" & range("D1")).).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Feuil1").Select
    Range("U1").Select
    ActiveSheet.Paste
    Range("A1").Select
Tableau = Split(Range("E1"), ",")
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(range("F1")).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


Je n'ai pas testé...

Bonne journée,

Ninbihan
 
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
Re : Incrémentation formule

Bonjour le fil :),
head_tatty à dit:
La forme de ma macro n' a pas d' importance, ni son contenu, ni les feuilles qu' elle désigne...Tout ce que je veux c' est que les noms cellules que j' ai mis en rouge soit remplacées par leur contenu en gardant tel quel tout ce que je n' ai pas mis en rouge.
Cliquez pour agrandir...
Si je te lis stricto senso, je testerais
Code: 
Dim Cellule As Range
For Each Cellule In Sheets("Feuil1").Range("A1:F10")
Cellule = Sheets("A").Range(Cellule.Text)
Next
S'il faut récupérer le nom de la feuille dans une autre cellule, ou dans la même avec un séparateur type ";", c'est possible aussi.
Bon courage :cool:
 
Vote positif 0 Vote négatif

Discussions similaires

R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
272
robpellan52
R
G
  • Résolu(e)
XL 2013 copier coller valeur d'une colonne dynamique
Réponses
13
Affichages
340
gwenn49
G
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
1 K
AtTheOne
AtTheOne
O
  • Question
XL 2010 aide sur code VBA collationnement de données
Réponses
10
Affichages
445
olivier388
O
Usine à gaz
  • Résolu(e)
XL 2021 Ecrire dans une une autre feuille
Réponses
3
Affichages
314
Usine à gaz
Usine à gaz
xvella
  • Question
Microsoft 365 [Résolu] Vba Excel Mise à jour Colonne
Réponses
2
Affichages
349
xvella
xvella
F
  • Résolu(e)
XL 2021 Réaliser une macro pour copier une ligne avec formule ?
Réponses
4
Affichages
374
fanou06
F
mouchtre
  • Résolu(e)
Microsoft 365 Macro fonctionnant avec excel 365 sur windows 11 mais ne fonctionnent pas sur un autre windows 11 avec aussi un excel 365
Réponses
11
Affichages
535
mouchtre
mouchtre
F
  • Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
186
Francky79
F
K
  • Question
XL 2019 Organiser le code VBA
Réponses
9
Affichages
563
Kevin38
K

Membres actuellement en ligne

1 membres et 43 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 248
Messages
2 086 593
Membres
103 248
dernier inscrit
Happycat