Problème RANGE(cells(),cells())

iadi06 Messages postés 21 Statut Membre -  
iadi06 Messages postés 21 Statut Membre -
Bonjour,

je suis novice dans la programmation VB / VBA. Et je rencontre des difficulté dans l'utilisation des range(cells(),cells()) qui fonctionne dans des cas et pas dans d'autres.

Voici ce que j'aimerais faire : copier une cellule d'une feuille dans une plage d'une autre feuille.

Voici le code qui bloque au premier range en gras :

Sub SequenceHorizontal()

Dim NbCol As Integer
Dim NbTache As Integer
Dim NbLigne As Integer
Dim NbCopy As Byte 'égale à la durée de la tâche
Dim DebutTache As Byte 'égale au jour (relatif à la séquence) de début de la tâche
Dim i As Byte 'variable pour boucle for
Dim EmptyCase As Byte 'variable qui sert à localiser la ligne vide pour pouvoir y copier la suite de la séquence

'Initialisation des tâches
NbLigne = 4
NbTache = 0
EmptyCase = 3
NbCopy = 1
NbCol = DebutTache + NbCopy

Application.ScreenUpdating = False 'Désactive la mise à jour écran qui permet d'optimiser la vitesse d'exécution du code
Sheets("SeqVert").Select

'Compte le nombre de tâche dans la séquence
Do
Cells(NbLigne, 3).Select
NbLigne = NbLigne + 1
NbTache = NbTache + 1

Loop Until IsEmpty(ActiveCell) 'Application.ActiveCell.CountBlank = 1

Cells(13, 1).Value = NbLigne
Cells(14, 1).Value = NbTache

'Copie la séquence en mode horizontal dans la feuille Séquence horizontale
For i = 4 To NbTache
Sheets("SeqVert").Select
NbCopy = Cells(i, 5).Value
DebutTache = Cells(i, 6).Value
EmptyCase = 3 'Réinitialise EmptyCase (variable qui sert à localiser la ligne vide pour pouvoir y copier la suite de la séquence)
Application.CutCopyMode = xlCopy
Cells(i, 3).Copy
If NbCopy > 1 Then 'Permet de copier la case plusieurs fois ou qu'une seule fois
Do
Sheets("SeqHor").Select
Range(Cells(EmptyCase, DebutTache), Cells(EmptyCase, DebutTache + NbCopy)).Select
ActiveSheet.Paste
EmptyCase = EmptyCase + 1
Loop Until IsEmpty(ActiveCell) = True

Else
Do
Sheets("SeqHor").Select
Cells(EmptyCase, DebutTache).Select
ActiveSheet.Paste
EmptyCase = EmptyCase + 1
Loop Until IsEmpty(ActiveCell) = True
End If
Application.CutCopyMode = False
Next i

End Sub

Pouvez-vous m'aider ?

Merci d'avance.

4 réponses

  1.
    Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 784
     
    Bonjour,

    Puisque tu débutes en VBA, autant prendre quelques bonnes habitudes dès maintenant. Tu devrais revoir entièrement ton code.

    1. Respecter certaines règles de nommage des variables, notamment l'emploi d'un préfixe qui identifie le type de variable : le code est plus lisible par tous. Plus d'explications ici : Conventions typographiques

    2. La programmation exige beaucoup de rigueur, voici quelques conseils qui t'éviterons bien des déboires :
    • commences tous les modules par Option Explicit, cela oblige à déclarer toutes les variables, ça évite les ambigüités et ça limite les risques d'erreur.
    • déclares les variables avec le type ad hoc (i.e. pas toutes en Variant)
    • limites leur portée au strict nécessaire (i.e. locale, privée, publique ou globale) ;
    • envisages tous les types potentiels de chaque variable pour éviter les erreurs ;
    • dans le doute prévois un gestionnaire d"erreur ;
    • n'utilises jamais .Select, évites d'utiliser les objets actifs : Selection, Activecell, Activesheet, ... ;
    • évites les références implicites(i.e. partielles), privilégies les références explicites (i.e. suffisamment complètes),
    --- par exemple, au lieu de 
    = Cells(1,2)
    écrire 
    = Worksheets(1).Cells(1,2).Value
    ,
    donc, précises toujours la feuille pour un objet Range (Cells, Rows, ...) et la propriété cible (Value, Text, ...)
    • n'hésites pas à utiliser des variables pour représenter les objets, ça facilite l'écriture et la lecture du code,
    --- par exemple : 
    Set MaPlage = Me.Range("B2:C8")
    ;
    • pour les mêmes raisons, n'hésites pas à utiliser aussi 
    With
    et 
    End With
    ;
    • évites d'utiliser des propriétés ou méthodes d'objet héritées qui pourraient ne pas exister,
    --- par exemple, au lieu de : 
    Sheets(1).Range("A1")
    écrire 
    Workheets(1).Range("A1")
    ,
    en effet l'objet Range n'appartient pas à Sheet mais à Worksheet ;
    • éviter d'utiliser le Presse-Papier, préfères la copie directe avec une destination 
    Source.Copy Destination
    ou
    bien, pour copier uniquement les valeurs : 
    Destination.valeur = Source.Valeur
    .

    Tu trouveras ici un excellent cours VBA gratuit pour débutants (et plus si affinités ...),
    même si, pour simplifier les explications, il n'applique pas toujours les conseils précédents :
    ftp://ftp-developpez.com/bidou/Cours/VBA/formationVBA.pdf

    1
    1. iadi06 Messages postés 21 Statut Membre
       
      Merci, Patrice33740 pour tous ces bons conseils.

      Je vais tâcher de les utiliser dans ce même code.

      Si je comprends bien, mon code engendre une erreur à cause d'un problème de syntaxe et donc je dois le reprendre dans son intégralité. Je vais essayer, merci.
      0
    2. Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 784
       
      Commences par supprimer les .select
      Définit des objets Worksheet et/ou Range et agit dessus sans les sélectionner.
      Au lieu d'une boucle, pour trouver la première ligne libre, utilises .End()
      0
    3. iadi06 Messages postés 21 Statut Membre
       
      Par contre,

      Voilà ce que j'aimerais faire : copier une cellule d'une feuille dans une plage d'une autre feuille.

      Mais je n'ai pas dit qu'en fait, je souhaite que si la case de destination est non vide, le programme copie dans la ligne du dessous (si celle-ci également est non vide), il copiera dans la cellule en dessous.

      Voilà pourquoi j'ai mis une boucle.

      Je travaille sur le sujet là.

      Dès que j'ai revu tous les problèmes de syntaxe et autres, je poste le code.
      0
    4. Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 784
       
      Avec .End(xlUp).Offset(1), la case de destination est toujours vide, pas besoin de boucle !
      0
    5. iadi06 Messages postés 21 Statut Membre
       
      J'ai avancé sur le code. Malheureusement, j'ai toujours la même erreur : "Erreur 1004".

      Public Sub SequenceHorizontal()

      Dim intNbCol As Integer
      Dim intNbTache As Integer
      Dim intNbLigne As Integer
      Dim bytNbCopy As Byte 'égale à la durée de la tâche
      Dim bytDebutTache As Byte 'égale au jour (relatif à la séquence) de début de la tâche
      Dim I As Byte 'variable pour boucle for
      Dim bytEmptyCase As Byte 'variable qui sert à localiser la ligne vide pour pouvoir y copier la suite de la séquence
      Dim rCopRange As Range
      Dim rDestRange As Range


      'Initialisation des tâches
      intNbLigne = 4
      intNbTache = 0
      'bytEmptyCase = 3
      bytNbCopy = 1
      intNbCol = bytDebutTache + bytNbCopy
      Dim sError As String

      Application.ScreenUpdating = False 'Désactive la mise à jour écran qui permet d'optimiser la vitesse d'exécution du code
      Worksheets("SeqVert").Activate

      'Compte le nombre de tâche dans la séquence
      If Me.Cells(4, 3) <> 0 Then
      Do
      Me.Cells(intNbLigne, 3).Select
      intNbLigne = intNbLigne + 1
      intNbTache = intNbTache + 1
      Loop Until IsEmpty(ActiveCell)

      Else
      sError = MsgBox("Merci de renseigner les séquences", vbExclamation + vbOKOnly)
      End If


      'Ligne à supprimer, sert à vérifier si le code est ok.
      Me.Cells(13, 1).Value = intNbLigne
      Me.Cells(14, 1).Value = intNbTache

      'Copie la séquence en mode horizontal dans la feuille Séquence horizontale
      For I = 4 To intNbTache
      bytNbCopy = Me.Cells(I, 5).Value
      bytDebutTache = Me.Cells(I, 6).Value

      If bytNbCopy > 1 Then 'Permet de copier la case plusieurs fois ou qu'une seule fois

      Set rCopRange = Me.Cells(I, 3)
      Set rDestRange = Worksheets("SeqHor").Range(Cells(I, bytDebutTache), Cells(I, bytDebutTache + bytNbCopy))
      Worksheets("SeqVert").rCopRange.Copy Worksheets("SeqHor").rDestRange.End(xlUp).Offset(1, 0)

      Else
      Set rCopRange = Me.Cells(I, 3)
      Set rDestRange = Worksheets("SeqHor").Cells(I, bytDebutTache)
      Worksheets("SeqVert").rCopRange.Copy Worksheets("SeqHor").rDestRange.End(xlUp).Offset(1, 0)

      End If
      Application.CutCopyMode = False
      Next I


      End Sub
      0
  2. Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 784
     
    Bonjour,

    C'est un bon début.

    Lorsque qu'un code concerne plusieurs feuilles, il est préférable de le mettre dans un module standard. En général on réserve le module de feuille aux procédures évènementielles (et aux procédures associées).

    Je te rappelle : ne jamais utiliser .Select (sauf dans le cas où ce serait vraiment indispensable, mais je n'ai jamais rencontré ce cas).

    Sans voir le classeur, je ne suis pas sûr d'avoir tous les éléments, mais il me semble que ce code devrait correspondre à ce que tu cherches : 
    Option Explicit
Public Sub SequenceHorizontal()
'
Dim wshVert As Worksheet
Dim rngCop As Range
Dim rngDest As Range
Dim intDerLigne As Integer
Dim bytNbCopy As Byte                            'égale à la durée de la tâche
Dim bytDebutTache As Byte                        'égale au jour (relatif à la séquence) de début de la tâche
Dim I As Byte                                    'variable pour boucle for

  Application.ScreenUpdating = False             'Désactive la mise à jour écran qui permet d'optimiser la vitesse d'exécution du code
  Set wshVert = Worksheets("SeqVert")
  'Compte le nombre de tâche dans la séquence
  If wshVert.Cells(4, 3) <> 0 Then
    intDerLigne = 3
    Do      'On doit pouvoir éviter cette boucle mais il me manque des infos.
      intDerLigne = intDerLigne + 1
    Loop Until IsEmpty(wshVert.Cells(intDerLigne + 1, 3))
  Else
    MsgBox "Merci de renseigner les séquences", vbExclamation
  End If
  'Ligne à supprimer, sert à vérifier si le code est ok.
  wshVert.Cells(13, 1).Value = intDerLigne
  'Copie la séquence en mode horizontal dans la feuille Séquence horizontale
  For I = 4 To intDerLigne
    bytNbCopy = wshVert.Cells(I, 5).Value
    bytDebutTache = wshVert.Cells(I, 6).Value
    Set rngCop = wshVert.Cells(I, 3)
    Set rngDest = Worksheets("SeqHor").Cells(I, bytDebutTache).Resize(1, bytNbCopy)
    rngCop.Copy rngDest
  Next I
  Application.ScreenUpdating = True
  
End Sub


    1
    1. iadi06 Messages postés 21 Statut Membre
       
      Merci Patrice,

      effectivement, je pense que cette boucle peut être évitée.

      Do 'On doit pouvoir éviter cette boucle mais il me manque des infos.
      intDerLigne = intDerLigne + 1
      Loop Until IsEmpty(wshVert.Cells(intDerLigne + 1, 3))

      Elle sert juste à compter le nombre de case non vide entre la cellule C3 et la dernière cellule non vide de la colonne. Cette valeur (inDerLigne) me sert ensuite dans la boucle for.

      Il y a peut-être un moyen de calculer plus efficiemment cette valeur.

      Je vais essayer demain de refaire un test avec ce que vous m'avez envoyé. Puis je vous fais un retour.

      Merci Patrice.

      Cordialement, Adi.
      0
    2. Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 784
       
      l'info qui manque c'est : Y-a-t'il toujours une donnée en C3 ?
      Si c'est le cas on peut remplacer : 
        If wshVert.Cells(4, 3) <> 0 Then
    intDerLigne = 3
    Do      'On doit pouvoir éviter cette boucle mais il me manque des infos.
      intDerLigne = intDerLigne + 1
    Loop Until IsEmpty(wshVert.Cells(intDerLigne + 1, 3))
  Else
    MsgBox "Merci de renseigner les séquences", vbExclamation
  End If
      Par 
        If wshVert.Cells(4, 3) <> 0 Then
    intDerLigne = wshVert.Cells(3, 3).End(xlDown).Row
  Else
    MsgBox "Merci de renseigner les séquences", vbExclamation
  End If
      0
      1. iadi06 Messages postés 21 Statut Membre > Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention  
         
        Effectivement, ça change tout si elle est vide ou non.

        Je vais partir sur un oui. Et donc le code doit être modifié : 

         If wshVert.Cells(4, 3) <> 0 Then
    intDerLigne = wshVert.Cells(4, 3).End(xlDown).Row
  Else
    MsgBox "Merci de renseigner les séquences", vbExclamation
  End If


        Mais il faut quand même lui rajouter 3. Cependant, en essayant avec ce code la ; j'ai eu une incompatibilité de type.
        0
    3. iadi06 Messages postés 21 Statut Membre
       
      Parfait ! J'ai exactement le code qu'il me fallait :

      Option Explicit
      Public Sub SequenceHorizontal()

      Dim wshVert As Worksheet
      Dim rngCop As Range
      Dim rngDest As Range
      Dim intDerLigne As Integer
      Dim bytNbCopy As Byte 'égale à la durée de la tâche
      Dim bytDebutTache As Byte 'égale au jour (relatif à la séquence) de début de la tâche
      Dim I As Byte 'variable pour boucle for

      Application.ScreenUpdating = False 'Désactive la mise à jour écran qui permet d'optimiser la vitesse d'exécution du code
      Set wshVert = Worksheets("SeqVert")
      'Compte le nombre de tâche dans la séquence
      If wshVert.Cells(4, 3) <> 0 Then
      intDerLigne = 3
      intDerLigne = intDerLigne + Application.WorksheetFunction.CountA(Range("C4:C" & Range("C65536").End(xlUp).Row))
      Else
      MsgBox "Merci de renseigner les séquences", vbExclamation
      End If

      'Copie la séquence en mode horizontal dans la feuille Séquence horizontale
      For I = 4 To intDerLigne
      bytNbCopy = wshVert.Cells(I, 5).Value
      bytDebutTache = wshVert.Cells(I, 6).Value
      Set rngCop = wshVert.Cells(I, 3)
      Set rngDest = Worksheets("SeqHor").Cells(3, bytDebutTache).Resize(1, bytNbCopy)
      If Worksheets("SeqHor").Cells(3, bytDebutTache) <> "" Then
      Set rngDest = Worksheets("SeqHor").Cells(1, bytDebutTache).End(xlDown).Offset(1, 0).Resize(1, bytNbCopy) 'Permet de ne pas écraser les cases déjà copiées
      rngCop.Copy rngDest
      Else
      rngCop.Copy rngDest
      End If
      Next I
      Application.ScreenUpdating = True

      End Sub


      Mais j'avoue que je ne comprends toujours pas pourquoi la commande suivante ne fonctionnait pas :
      Set rDestRange = Worksheets("SeqHor").Range(Cells(I, bytDebutTache), Cells(I, bytDebutTache + bytNbCopy))
      Worksheets("SeqVert").rCopRange.Copy Worksheets("SeqHor").rDestRange.End(xlUp).Offset(1, 0)

      Je pense que c'est le range(cells(),cells()) qui n'est pas interprété comme j'aurais voulu qu'il le soit.

      Finalement, j'ai enlevé la boucle Do ... Loop

      Parfait, maintenant, je vais pouvoir aller au bout de la programmation.
      0
  3. diablo13800 Messages postés 3469 Date d'inscription   Statut Membre Dernière intervention   1 872
     
    Bonjour,

    Quelle est l'erreur qui vous est renvoyée?
    0
    1. iadi06 Messages postés 21 Statut Membre
       
      Bonjour, j'ai une erreur '1004'
      erreur définir par l'application ou par l'objet
      0
  4. Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 784
     
    Bonjour,

    « Mais il faut quand même lui rajouter 3. » Non c'est inutile puisque on obtient le numéro de la dernière ligne utilisée et qu'on boucle ensuite à partir de 4 jusqu'à ce numéro.
    Par contre l'utilisation de CountA n'est pas conseillée car elle ne compte que les cellules non vides, ce qui risque de poser problème dans le cas où certaines cellules seraient vides (et il ne faut jamais ignorer une erreur improbable, car elle finit toujours par se produire).

    Au lieu de : 
    intDerLigne = 3
intDerLigne = intDerLigne + Application.WorksheetFunction.CountA(Range("C4:C" & Range("C65536").End(xlUp).Row))

    Il suffit de : 
    intDerLigne = Range("C4:C" & Range("C65536").End(xlUp).Row)
    0
    1. iadi06 Messages postés 21 Statut Membre
       
      Il y aura une incompatibilité de type avec cette formule.

      intDerLigne est un integer égale à un type Range.

      C'est pour ça que j'ai voulu passer par un countA sachant qu'il n'y aura jamais de vide dans ma plage de copie.

      Ou peut-être écrire 


      
intDerLigne = Range("C4:C" & Range("C65536").End(xlUp).Row).Row
'ou
intDerLigne = Range("C4:C" & Range("C65536").End(xlUp)).Row


      J'ai testé, et cela ne fonctionne pas dans les deux cas.
      0
    2. Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 784
       
      Oups, C'est plutôt :
      intDerLigne = Range("C65536").End(xlUp).Row
      0
    3. iadi06 Messages postés 21 Statut Membre > Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention  
       
      Parfait, ça fonctionne et le code est un peu plus rapide du coup.
      0
    4. iadi06 Messages postés 21 Statut Membre
       
      Je ne comprends pas de la même manière pourquoi ce code ne fonctionne pas. 

      Option Explicit

Public Sub SequenceVertical()

Dim wshVert As Worksheet
Dim rngCopie As Range
Dim rngDestn As Range
Dim bytNbSeq As Byte
Dim bytNbTyp As Byte
Dim sAlert As String
Dim intNbCol As Integer

Set wshVert = Worksheets("SeqVert")
Application.ScreenUpdating = False
Set rngCopie = wshVert.Range("B1", "G65536")
    intNbCol = 9    'Localisation de la colonne destinataire de la copie

If wshVert.Cells(2, 1) <> 0 Then
    bytNbSeq = wshVert.Range("A2").Value

    For bytNbTyp = 1 To bytNbSeq - 1
        Set rngDestn = wshVert.Cells(1, intNbCol).Resize(65536, 6)
        rngCopie.Copy rngDestn
        intNbCol = intNbCol + 7
    Next bytNbTyp
Else
    sAlert = MsgBox("Veuillez saisir le nombre de typologie de séquence", vbOKOnly + vbExclamation, "Les typologies séquences")
End If

Application.ScreenUpdating = True

End Sub
      0
    5. Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 784
       
      Il serait préférable de ne copier que la plage concernée (et pas 65536 lignes) :
      EDIT : 
      Option Explicit
Public Sub SequenceVertical()
'
Dim wshVert As Worksheet
Dim rngCopie As Range
Dim rngDestn As Range
Dim strCopie As String
Dim strAlert As String
Dim intNoCol As Integer
Dim intNbCol As Integer
Dim bytNbSeq As Byte
Dim bytNbTyp As Byte
  Set wshVert = Worksheets("SeqVert")
  strCopie = "B:G"  'Colonnes à copier
  bytNbSeq = Val(wshVert.Range("A2").Value)
  Application.ScreenUpdating = False
  Set rngCopie = Intersect(wshVert.Range(strCopie), wshVert.UsedRange)
  intNbCol = rngCopie.Columns.Count      'Nombre de colonnes à copier
  intNoCol = rngCopie.Column             'Numéro de la colonne source
  If bytNbSeq > 0 Then
    For bytNbTyp = 1 To bytNbSeq - 1
      intNoCol = intNoCol + intNbCol + 1 'Numéro de la colonne de destination
      Set rngDestn = wshVert.Cells(1, intNoCol).Resize(rngCopie.Rows.Count, rngCopie.Columns.Count)
      rngCopie.Copy rngDestn
    Next bytNbTyp
  Else
    strAlert = MsgBox("Veuillez saisir le nombre de typologie de séquence", vbOKOnly + vbExclamation, "Les typologies séquences")
  End If
  Application.ScreenUpdating = True
End Sub
      0

Discussions similaires

Ecran BenQ "Input signal out of range"
marlene -
usman000 -

14 réponses
Ecran noir avec 'out of range" sous windows 10
SAPHIR13600 -
SAPHIR13600 -

5 réponses
comment désactiver out of range
lzri98 -
jeannets -

3 réponses
Problème écran "out of range" au démarrage
Nast79 -
cathy -

8 réponses
input range
Bruno -
Bruno -

2 réponses