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

Fermé
Signaler
Messages postés
19
Date d'inscription
mercredi 20 février 2019
Statut
Membre
Dernière intervention
15 décembre 2020
-
Messages postés
19
Date d'inscription
mercredi 20 février 2019
Statut
Membre
Dernière intervention
15 décembre 2020
-
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

Messages postés
8539
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
20 juillet 2021
1 734
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
Messages postés
19
Date d'inscription
mercredi 20 février 2019
Statut
Membre
Dernière intervention
15 décembre 2020

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
Messages postés
8539
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
20 juillet 2021
1 734
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
Messages postés
19
Date d'inscription
mercredi 20 février 2019
Statut
Membre
Dernière intervention
15 décembre 2020

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
Messages postés
8539
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
20 juillet 2021
1 734
Avec .End(xlUp).Offset(1), la case de destination est toujours vide, pas besoin de boucle !
0
Messages postés
19
Date d'inscription
mercredi 20 février 2019
Statut
Membre
Dernière intervention
15 décembre 2020

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
Messages postés
8539
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
20 juillet 2021
1 734
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
Messages postés
19
Date d'inscription
mercredi 20 février 2019
Statut
Membre
Dernière intervention
15 décembre 2020

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
Messages postés
8539
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
20 juillet 2021
1 734
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
Messages postés
19
Date d'inscription
mercredi 20 février 2019
Statut
Membre
Dernière intervention
15 décembre 2020
>
Messages postés
8539
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
20 juillet 2021

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
Messages postés
19
Date d'inscription
mercredi 20 février 2019
Statut
Membre
Dernière intervention
15 décembre 2020

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
Messages postés
2755
Date d'inscription
jeudi 2 juillet 2015
Statut
Membre
Dernière intervention
10 janvier 2022
1 712
Bonjour,

Quelle est l'erreur qui vous est renvoyée?
0
Messages postés
19
Date d'inscription
mercredi 20 février 2019
Statut
Membre
Dernière intervention
15 décembre 2020

Bonjour, j'ai une erreur '1004'
erreur définir par l'application ou par l'objet
0
Messages postés
8539
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
20 juillet 2021
1 734
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
Messages postés
19
Date d'inscription
mercredi 20 février 2019
Statut
Membre
Dernière intervention
15 décembre 2020

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
Messages postés
8539
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
20 juillet 2021
1 734
Oups, C'est plutôt :
intDerLigne = Range("C65536").End(xlUp).Row
0
Messages postés
19
Date d'inscription
mercredi 20 février 2019
Statut
Membre
Dernière intervention
15 décembre 2020
>
Messages postés
8539
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
20 juillet 2021

Parfait, ça fonctionne et le code est un peu plus rapide du coup.
0
Messages postés
19
Date d'inscription
mercredi 20 février 2019
Statut
Membre
Dernière intervention
15 décembre 2020

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
Messages postés
8539
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
20 juillet 2021
1 734
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