Range dans une variable

[MinosA'Tuin]

Bonjour à tous,

J'ai un problème sur une macro que j'essaye de construire.
Quelques mots sur le contexte : j'ai un fichier où depuis une saisie dans un tableau, permet à l'utilisateur de générer plusieurs documents, qui sont ensuite archivé sur un serveur et/ou imprimé.

Dans ce tableau l'utilisateur peut reprendre plusieurs demandes pour un même client, la macro doit donc permettre de générer les documents pour chaque demande, la seule différence entre chaque demandes étant la colonne : c pour la 1ere demande, d pour la 2e...

j'ai donc utiliser une boucle avec un for, qui en fonction de i fait ressortir la bonne sélection de cellules mais je n'arrive à rien. j'ai l'impression que la variable ne s'alimente pas...

Sub ImpressionV2()

Dim max_boucles As Integer
Dim souscription As Range

Application.ScreenUpdating = False

max_boucles = Range("C15")

For i = 1 To 5
    If i > max_boucles Then
        Exit For
    End If
    
        If i = 1 Then
            Set souscription = Range("C17:C25")
            Else
                If i = 2 Then
                Set souscription = Range("D17:D25")
                Else
                    If i = 3 Then
                    Set souscription = Range("E17:E25")

                    Else
                        If i = 4 Then
                        Set souscription = Range("F17:F25")
                        Else
                        Set souscription = Range("G17:G25")
                        End If
                    End If
                End If
          End If
         
         
            Worksheets("Sommaire").Select

            soucription.select
Selection.copy


            Sheets("Souscription").Select
            Range("B2").Select
            Selection.PasteSpecial Paste:=xlPasteValues

            If Worksheets("Souscription").Range("B5") < 60000 And Worksheets("Sommaire").Range("E13") = "Non" Then

            Worksheets("doc").PrintOut
            Worksheets("docclient").PrintOut

            Else

            Worksheets("docclient").PrintOut
            Worksheets("docboite").PrintOut
            Worksheets("docboite2").PrintOut

            End If

            Unload souscription
           
    
    Next

Worksheets("Sommaire").Activate

Application.ScreenUpdating = True

End Sub

Des idées d'où vient mon erreur?

D'avance merci pour votre aide, sur mon code ou vers un sujet qui répondrai à ma problématique.

Minos

 

[fanfan38]

Bonjour et bienvenue
Un fichier est toujours apprécié...
Plutôt qu'un if i=...
je mettrai plutôt un select case i
case=1
Set souscription = Range("C17:C25")
case=2
Set souscription =
etc...
case else
Set souscription =
end select

Je pense que ton erreur vient de là:
Sheets("Souscription").Select
selection.copy
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues

A+ François

 

[MinosA'Tuin]

Bonjour François et merci pour votre réponse ,

Pour le fichier j'ai bien conscience que c'est plus facile avec que sans, mais il s'agit d'un fichier pro qui demanderai beaucoup de temps pour l'anonymiser, mais si cela devient indispensable je ferais le nécessaire.

je connaissais pas case et son utilisation.

je viens de tester et j'ai maintenant une nouvelle erreur : Erreur de compilation Next sans For, alors que For est bien présent?

je remets mon code mis à jour.

Sub HubmailV3()
Dim max_boucles As Integer
Dim souscription As Range



Application.ScreenUpdating = False





   
max_boucles = Range("C15")

    For i = 1 To 5
    If i > max_boucles Then
        Exit For
    End If
    
    Select Case i
    Case Is = 1
    Set souscription = Range("C17:C25")
    Case Is = 2
    Set souscription = Range("D17:D25")
    Case Is = 3
    Set souscription = Range("E17:E25")
    Case Is = 4
    Set souscription = Range("F17:F25")
    Case Is = 5
    Set souscription = Range("G17:G25")
         
            Worksheets("Sommaire").Select

            soucription.Select
            Selection.Copy


            Sheets("Souscription").Select
            Range("B2").Select
            Selection.PasteSpecial Paste:=xlPasteValues

            If Worksheets("Souscription").Range("B5") < 60000 And Worksheets("Sommaire").Range("E13") = "Non" Then

            Worksheets("doc1").PrintOut
            Worksheets("doc2").PrintOut

            Else

            Worksheets("doc3").PrintOut
            Worksheets("doc4").PrintOut
            Worksheets("doc5").PrintOut

            End If

            Unload souscription
           
    
    Next



Worksheets("Sommaire").Activate

Application.ScreenUpdating = True

End Sub

Minos

 

[Dranreb]

Bonjour
Une boucle commençant comme ça devrait marcher :

For Each Sousrcription In Worksheets("Sommaire").Range("C17:G25").Columns
   With Worksheets("Souscription")
      .Range("B2:B10").Value = Souscription.Value

 

[fanfan38]

il manque le end select
et tu n'as toujours pas mis le selection.copy après le
Sheets("Souscription").Select

A+ François

 

[MinosA'Tuin]

J'ai rajouté le end select et modifié la macro pour que dans le select case soit sélectionné le range qui m'intéresse plutôt que stocker la valeur dans une variable qui soit ensuite sélectionné.

cela fonctionne.

merci pour votre aide et bonne journée.

ci dessous le code corrigé si cela peut servir à d'autres :

Sub ()

Dim max_boucles As Integer

Application.ScreenUpdating = False
   
max_boucles = Range("C15")

    For i = 1 To 5
    If i > max_boucles Then
        Exit For
    End If
    
    Worksheets("Sommaire").Select
    
    Select Case i
    Case Is = 1
    Range("C17:C25").Select
    Case Is = 2
    Range("D17:D25").Select
    Case Is = 3
    Range("E17:E25").Select
    Case Is = 4
    Range("F17:F25").Select
    Case Is = 5
    Range("G17:G25").Select
    End Select

    Selection.Copy

    Sheets("Souscription").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues

        If Worksheets("Souscription").Range("B5") < 60000 And Worksheets("Sommaire").Range("E13") = "Non" Then
   
        Worksheets("doc1").PrintOut
        Worksheets("doc2").PrintOut
   
        Else
   
        Worksheets("doc3").PrintOut
        Worksheets("doc4").PrintOut
        Worksheets("doc5").PrintOut
   
        End If
   
        Worksheets("Sommaire").Select
    
    Next


Worksheets("Sommaire").Activate

Application.ScreenUpdating = True

End Sub

 

[Staple1600]

Bonsoir le fil, le forum

@MinosA'Tuin
Pas sur d'avoir tout compris
Mais écrit ainsi, est-ce que le résultat est le même ?

Sub test()
Dim max_boucles As Integer
Application.ScreenUpdating = False
max_boucles = Range("C15")
For i = 1 To 5
  If i > max_boucles Then
  Exit For
  End If
  Range("C17:C25").Offset(, i - 1).Copy
  Sheets("Souscription").Range("B2").PasteSpecial xlPasteValues
  If Worksheets("Souscription").Range("B5") < 60000 And Worksheets("Sommaire").Range("E13") = "Non" Then
  Worksheets("doc1").PrintOut
  Worksheets("doc2").PrintOut
  Else
  Worksheets("doc3").PrintOut
  Worksheets("doc4").PrintOut
  Worksheets("doc5").PrintOut
  End If
Next
End Sub

 

[MinosA'Tuin]

Bonsoir,

Oui effectivement cela fonctionne également , et c'est encore plus simple avec juste ce offset .
Bon Select Case que je découvre, et offset que je redécouvre ce petit tour par le forum aura été utile.

Bonne soirée.