Range + Indirect + nom de cellule incrementable...

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion elglouton
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
E

elglouton

Guest
Bonjour le Forum,

Je tente de Créer une macro afin de copier une plage de cellule d'une feuille vers une autre.
Pour la plage a copier je recherche la plage dans une cellule de la feuille sur laquelle je copie (Z2) et je copie sur une autre feuille 12-48FE4 puis je copie (Z3) et je copie sur une autre feuille 12-48FE3 je copie (Z4) et je copie sur une autre feuille 12-48FE4.

Quand j'utilise la macro suivante cela fonctionne mais comment faire pour créer une variable et ainsi incrementer la cellule.

Code: 
Sheets("Données Chessel").Select
    Range("INDIRECT(Z2)").Select
    Selection.COPY
    Sheets(NFeuil).Select
    Range("A24").Select
    ActiveSheet.Paste
    Sheets("Saisie").Activate

J'ai tenté comme ça mais ça marche pas...

Code: 
Function FeuilExist(NomFeuil As String) As Boolean
Dim a
    FeuilExist = False
    On Error GoTo Err1
    a = Sheets(NomFeuil).Range("A1").Value
    FeuilExist = True
    Exit Function
Err1:
End Function
Sub CreeFeuilleEssais()
Dim NFeuil As String
Dim NomOnglet, Plage, Selec As Integer
For Plage = 8 To 25 Step 8
For NomOnglet = 3 To 25 Step 8
For Selec = 2 To 5 Step 1
If Sheets("Saisie").Cells([NomOnglet], [9]).Value <> "" Then
        NFeuil = Cells([NomOnglet], [9]).Value
        If FeuilExist(NFeuil) Then
            Sheets(NFeuil).Activate
            Exit Sub
        Else
            Sheets("Type").COPY After:=Sheets(ThisWorkbook.Sheets.Count)
            ActiveSheet.Name = NFeuil
            ActiveSheet.Range("Z1").Value = Sheets("Saisie").Cells([Plage], [9]).Value
        End If
    End If
    Sheets("Données Chessel").Activate
    Range("INDIRECT([26],[Selec])").Select
    Selection.COPY
    Sheets(NFeuil).Activate
    Range("A24").Activate
    ActiveSheet.Paste
    Next Selec
    Next NomOnglet
    Next Plage
End Sub

Je dois mal m'y prendre...http://cjoint.com/?0GsvbwzY1Dy
Si vous avez une voie sur laquelle me guider merci par avance

Elglouton
 
Trier par date Trier par votes
Re : Range + Indirect + nom de cellule incrementable...

bonjour elglouton
ton code changé
test(à tester) pour rechercher début et fin plage contenant date

Code: 
Sub CreeFeuilleEssais()
Dim NomFeuil As String
Dim NomOnglet ', Plage As Integer 'valeur de la cellule
Sheets("Saisie").Activate
With Sheets("Saisie")
derl = .Range("I65536").End(xlUp).Row
For l = 3 To derl Step 8 'boucle lignes
If .Cells(l, 9).Value <> "" Then 'tu peux aussi écrire Cells(l, "I")
        NomFeuil = .Cells(l, 9).Value
        If FeuilExist(NomFeuil) Then
            Sheets(NomFeuil).Activate
            Exit Sub
        Else
            Sheets("Type").COPY After:=Sheets(ThisWorkbook.Sheets.Count)
            ActiveSheet.Name = NomFeuil
            ActiveSheet.Range("Z1").Value = .Cells(l + 5, 9).Value
            ActiveSheet.Range("H1").Value = .Cells(l - 1, 9).Value
            ActiveSheet.Range("H2").Value = .Cells(l, 9).Value
            ActiveSheet.Range("H3").Value = .Cells(l + 1, 9).Value
        End If
    End If
    
'    .Range(.Cells(l - 1, 9), .Cells(l + 6, 9)).COPY Destination:=Sheets(NomFeuil).Range("A24")
'    adr = Sheets(NomFeuil).Range("A24").Address   '= donnée
    'Je tente de connaitre l'addresse de la plage collé afin de faire correspondre les differentes formules
    'Et aussi pouvoir introduire "uniformité" les bares en rose en fin de plage
    Next l
    End With
End Sub


Sub test()
x = Sheets("Saisie").Cells(5, 9).Value
Sheets("Données Chessel").Activate
    On Error Resume Next
        Set c = Cells.Find(What:=CDate(x), After:=Range("A1"), LookIn:=xlFormulas _
            , LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
    On Error GoTo 0
'ld ligne début lf ligne fin
 If Not c Is Nothing Then
        firstAddress = c.Address
        ld = c.Row: lf = ld - 1
        Do
           lf = lf + 1
            Set c = Cells.FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
        Else: MsgBox "pas trouvé"
    End If
    
End Sub
 
Vote positif 0 Vote négatif
Re : Range + Indirect + nom de cellule incrementable...

Bonjour ElGlouton, Bebere, bonjour le forum,

Ton code modifié ci-dessous :
Code: 
Sub CreeFeuilleEssais()
Dim Plage As Byte
Dim NomOnglet As Byte
Dim NFeuil As String
Dim ad As String 'déclare la variable ad (ADresse)
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)

For Plage = 8 To 25 Step 8
    For NomOnglet = 3 To 25 Step 8 'boucle for
        With Sheets("Saisie")
            .Select
            If .Cells(NomOnglet, 9).Value <> "" Then
                    NFeuil = .Cells(NomOnglet, 9).Value
                    If FeuilExist(NFeuil) Then
                        Sheets(NFeuil).Activate
                        Exit Sub
                    Else
                        Sheets("Type").Copy After:=Sheets(ThisWorkbook.Sheets.Count)
                        ActiveSheet.Name = NFeuil
                        ActiveSheet.Range("Z1").Value = Sheets("Saisie").Cells(Plage, 9).Value
                    End If
            End If
            ad = CStr(.Cells(Plage, 9).Value) 'définit l'adresse ad
        End With
        With Sheets("Données Chessel")
            .Range(ad).Copy Sheets(NFeuil).Range("A24") 'copie la plage et la colle dans A24 de l'ongle NFeuil
        End With
        With Sheets(NFeuil) 'prend en compte l'onglet NFeuil
            dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row + 1 'définit la dernière ligne dl
            Sheets("Type").Rows(28).Copy .Cells(dl, 1) 'copie la ligne 28 de l'onglet "Type" et la colle en ligne dl
            'place la formule en colonne D/ligne dl - 1
            .Cells(dl, 4).Formula = "=Max(" & .Range(.Cells(24, 4), .Cells(dl - 1, 4)).Address(0, 0) & ") - Min(" & .Range(.Cells(24, 4), .Cells(dl - 1, 4)).Address(0, 0) & ")"
            'recopie la formule jusqu'à la colonne T
            .Cells(dl, 4).AutoFill Destination:=.Range(.Cells(dl, 4), .Cells(dl, 20)), Type:=xlFillDefault
            'place la formule en U24
            .Cells(24, 21).Formula = "=Max(" & .Range(.Cells(24, 4), .Cells(24, 20)).Address(0, 0) & ") - Min(" & .Range(.Cells(24, 4), .Cells(24, 20)).Address(0, 0) & ")"
            'recopie la formule jusqu'à la ligne dl - 1
            .Cells(24, 21).AutoFill Destination:=.Range(.Cells(24, 21), .Cells(dl - 1, 21)), Type:=xlFillDefault
            'colore la colonne U
            .Range(.Cells(24, 21), .Cells(dl - 1, 21)).Interior.ColorIndex = .Range("U23").Interior.ColorIndex
            'place la formule en G11
            .Range("G11").Formula = "=Min(" & .Range(.Cells(24, 4), .Cells(dl - 1, 20)).Address(0, 0) & ")"
            'place la formule en G12
            .Range("G12").Formula = "=Max(" & .Range(.Cells(24, 4), .Cells(dl - 1, 20)).Address(0, 0) & ")"
            'place la formule en G13
            .Range("G13").Formula = "=Min(" & .Range(.Cells(24, 3), .Cells(dl - 1, 3)).Address(0, 0) & ")"
            'place la formule en G14
            .Range("G14").Formula = "=Max(" & .Range(.Cells(24, 3), .Cells(dl - 1, 3)).Address(0, 0) & ")"
            
            'Attention ! pour des raisons que j'ignore il faut faire [F2] puis [Enter] sur B18 et C18
            'sinon la formule ne s'affiche pas. J'ai essayé avec "SendKeys" sans succès !
            
            'place la formule en B18
            .Range("B18").Formula = "=MOYENNE(" & .Range(.Cells(24, 4), .Cells(dl - 1, 20)).Address(0, 0) & ")"
            'place la formule en C18
            .Range("C18").Formula = "=MOYENNE(" & .Range(.Cells(24, 3), .Cells(dl - 1, 3)).Address(0, 0) & ")"
        End With 'fin de la prise en compte de l'onglet NFeuil
    Next NomOnglet
Next Plage
End Sub
 
Vote positif 0 Vote négatif
Re : Range + Indirect + nom de cellule incrementable...

Bonjour Mesieu,

Un grand merci pour vos réponses ça fonctionne nikel j'ai pris votre code Robert et j'ai ajouter une partie du code de Berbère afin de copier les cellules en H1/2&3.
Pour ce qui est des formule Moyenne où la mise a jour ne se faisait pas toute seule j'ai changer le mot Moyenne par AVERAGE faut croire qu'Exel préféré l'anglais pour certaine choses...

Encore un grand merci .

Oups...J'ai le denier Next qui n'est pas pris en compte
NomOnglet n'est donc pas incrémentée et la plage de sélection ne change pas.
Je ne vois pas de quoi ça viens...Une idée 😕

Code: 
Sub CreeFeuilleEssais()
Dim Plage As Byte
Dim NomOnglet, l As Byte
Dim NFeuil As String
Dim ad As String 'déclare la variable ad (ADresse)
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)

For Plage = 8 To 25 Step 8
For NomOnglet = 3 To 25 Step 8

With Sheets("Saisie")
            .Select
            If .Cells(NomOnglet, 9).Value <> "" Then
                    NFeuil = .Cells(NomOnglet, 9).Value
                    If FeuilExist(NFeuil) Then
                        Sheets(NFeuil).Activate
                        Exit Sub
                    Else
                        Sheets("Type").COPY After:=Sheets(ThisWorkbook.Sheets.Count)
                        ActiveSheet.Name = NFeuil
                        ActiveSheet.Range("Z1").Value = Sheets("Saisie").Cells(Plage, 9).Value
                        ActiveSheet.Range("I1").Value = .Cells(NomOnglet - 1, 9).Value
                        ActiveSheet.Range("I2").Value = .Cells(NomOnglet, 9).Value
                        ActiveSheet.Range("I3").Value = .Cells(NomOnglet + 1, 9).Value
                    End If
            End If
            ad = CStr(.Cells(Plage, 9).Value) 'définit l'adresse ad
        End With
        With Sheets("Données Chessel")
            .Range(ad).COPY Sheets(NFeuil).Range("A24") 'copie la plage et la colle dans A24 de l'ongle NFeuil
        End With
        With Sheets(NFeuil) 'prend en compte l'onglet NFeuil
            dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row + 1 'définit la dernière ligne dl
            Sheets("Type").Rows(28).COPY .Cells(dl, 1) 'copie la ligne 28 de l'onglet "Type" et la colle en ligne dl
            'place la formule en colonne D/ligne dl - 1
            .Cells(dl, 4).Formula = "=Max(" & .Range(.Cells(24, 4), .Cells(dl - 1, 4)).Address(0, 0) & ") - Min(" & .Range(.Cells(24, 4), .Cells(dl - 1, 4)).Address(0, 0) & ")"
            'recopie la formule jusqu'à la colonne T
            .Cells(dl, 4).AutoFill Destination:=.Range(.Cells(dl, 4), .Cells(dl, 20)), Type:=xlFillDefault
            'place la formule en U24
            .Cells(24, 21).Formula = "=Max(" & .Range(.Cells(24, 4), .Cells(24, 20)).Address(0, 0) & ") - Min(" & .Range(.Cells(24, 4), .Cells(24, 20)).Address(0, 0) & ")"
            'recopie la formule jusqu'à la ligne dl - 1
            .Cells(24, 21).AutoFill Destination:=.Range(.Cells(24, 21), .Cells(dl - 1, 21)), Type:=xlFillDefault
            'colore la colonne U
            .Range(.Cells(24, 21), .Cells(dl - 1, 21)).Interior.ColorIndex = .Range("U23").Interior.ColorIndex
            'place la formule en G11
            .Range("G11").Formula = "=Min(" & .Range(.Cells(24, 4), .Cells(dl - 1, 20)).Address(0, 0) & ")"
            'place la formule en G12
            .Range("G12").Formula = "=Max(" & .Range(.Cells(24, 4), .Cells(dl - 1, 20)).Address(0, 0) & ")"
            'place la formule en G13
            .Range("G13").Formula = "=Min(" & .Range(.Cells(24, 3), .Cells(dl - 1, 3)).Address(0, 0) & ")"
            'place la formule en G14
            .Range("G14").Formula = "=Max(" & .Range(.Cells(24, 3), .Cells(dl - 1, 3)).Address(0, 0) & ")"
           
            'Attention ! pour des raisons que j'ignore il faut faire [F2] puis [Enter] sur B18 et C18
            'sinon la formule ne s'affiche pas. J'ai essayé avec "SendKeys" sans succès !
           
            'place la formule en B18
            .Range("B18").Formula = "=AVERAGE(" & .Range(.Cells(24, 4), .Cells(dl - 1, 20)).Address(0, 0) & ")"
            'place la formule en C18
            .Range("C18").Formula = "=AVERAGE(" & .Range(.Cells(24, 3), .Cells(dl - 1, 3)).Address(0, 0) & ")"
        End With 'fin de la prise en compte de l'onglet NFeuil
    
    Next NomOnglet
    Next Plage
End Sub
 
Dernière modification par un modérateur:
Vote positif 0 Vote négatif
Re : Range + Indirect + nom de cellule incrementable...

bonjour elglouton,Robert
pour moi la boucle plage est inutile
si tu employes ces lignes les onglets ajoutés en G seront pris en compte
derl = .Range("I65536").End(xlUp).Row
For l = 3 To derl Step 8 'boucle lignes
lignes commentées changé

ActiveSheet.Range("Z1").Value = .Cells(NomOnglet + 5, 9).Value'changé
ActiveSheet.Range("I1").Value = .Cells(NomOnglet - 1, 9).Value
ActiveSheet.Range("I2").Value = .Cells(NomOnglet, 9).Value
ActiveSheet.Range("I3").Value = .Cells(NomOnglet + 1, 9).Value
End If
End If
ad = .Cells(NomOnglet + 5, 9).Value 'définit l'adresse ad changé
 
Vote positif 0 Vote négatif
Re : Range + Indirect + nom de cellule incrementable...

Bonjour,

Merci Berbere c'est Nikel ...
Un grand merci à vous deux pour m'avoir aider a finaliser mon tout 1er code "bon vous avez tout repris en fait" mais j'ai compris plein de chose
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

L
  • Résolu(e)
Microsoft 365 Erreur d'exécution 1004 : la méthode select de la classe Worksheet a échoué
Réponses
7
Affichages
262
LaurentVasseur
L
S
  • Résolu(e)
Microsoft 365 VBA Concaténer contenu de plusieurs cellules dans une seule avec séparateurs / évolutifs
Réponses
3
Affichages
632
spike29
S
A
  • Résolu(e)
XL 2016 Recherche d'un mot dans une cellule et surlignage de la ligne
Réponses
4
Affichages
571
Abi23
A
S
  • Résolu(e)
Microsoft 365 VBA Match: comment éviter l'erreur?
2
Réponses
29
Affichages
1 K
Dranreb
Dranreb
Lu76Fer
  • Résolu(e)
XL 2016 XLS - Comment déterminer les zones présentent au niveau d'une cellule ?
Réponses
2
Affichages
846
Lu76Fer
Lu76Fer
lestoiles1
  • Question Question
XL 2013 Sub commentaire
Réponses
2
Affichages
411
lestoiles1
lestoiles1
richardlion
  • Question Question
XL 2016 annulation ou désactivation de macro
2
Réponses
27
Affichages
1 K
job75
job75
S
  • Résolu(e)
Microsoft 365 Ecrasement d'une ligne si déjà existante
Réponses
2
Affichages
452
sebastien176
S
N
  • Résolu(e)
Microsoft 365 Calcul de plages horaires
2 3 4
Réponses
49
Affichages
3 K
NONO14
N
G
  • Résolu(e)
XL 2016 Pb de tri et sous totaux
2
Réponses
27
Affichages
2 K
Gestionnaire_rh
G
P
  • Question Question
XL 2021 Ajout/adaptation de code VBA sur feuille qui en contient déjà
Réponses
3
Affichages
426
Pierreavecunp
P
A
  • Question Question
VBA qui fonctionnait avant, mais ne fonctionne plus avec le 64 bits
Réponses
2
Affichages
744
patricktoulon
patricktoulon
E
  • Question Question
XL 2013 Code VBA
Réponses
12
Affichages
1 K
eutrophisation
E
K
  • Résolu(e)
XL 2016 Affichage TextBox
Réponses
6
Affichages
818
KRUG WOO
K
B
  • Question Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
1 K
Compte Supprimé 979
C
S
  • Résolu(e)
Microsoft 365 Récupérer la date dans un calendrier
Réponses
2
Affichages
677
sebastien176
S
T
  • Question Question
XL 2016 Erreur d'exécution 1004 : Impossible de définir la propriété Hidden de la classe Range
Réponses
3
Affichages
682
Phil69970
Phil69970
piga25
  • Résolu(e)
XL 2016 En VBA, Automatiser la réponse en fonction de l'état d'une cellule.
Réponses
7
Affichages
870
piga25
piga25
L
  • Question Question
VBA : erreur sur boucle
Réponses
2
Affichages
519
Latias
L
D
  • Question Question
XL 2021 Filtre Multi Critères Listview VBA
2
Réponses
21
Affichages
3 K
Dranreb
Dranreb
Retour