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

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.

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()

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.

Avec .End(xlUp).Offset(1), la case de destination est toujours vide, pas besoin de boucle !

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

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.

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

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.

Bonjour, j'ai une erreur '1004'
erreur définir par l'application ou par l'objet

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.

Oups, C'est plutôt :
intDerLigne = Range("C65536").End(xlUp).Row

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

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