Sujet Précédent Sujet Suivant

Selection d'informations à coller pour impression

Résolu/Fermé
gilles52300 Messages postés 35 Date d'inscription dimanche 12 mai 2013 Statut Membre Dernière intervention 1 octobre 2018 - 14 mai 2013 à 02:56
gilles52300 Messages postés 35 Date d'inscription dimanche 12 mai 2013 Statut Membre Dernière intervention 1 octobre 2018 - 15 mai 2013 à 13:27
Bonjour,

je veux faire une sélection d'information, sur une feuille 'Carnet', antérieur à une date et les coller sur la feuille 'écrasement' afin de lancer une impressions de ces éléments.

- ouvrir un userform pour inscrire la date voulue, le début et la fin des lignes à regarder ('Carnet' va avoir environ 2000 lignes en fin d'année)
- coller la date sur la feuille 'écrasement'
- débuter la recherche sur la feuille 'Carnet'
- vérifier si les conditions sont réunis.
si N° de rapport (range "E") vide vérifier la date prévue d'écrasement (range"N")
si date (range"N") supérieur à la date mentionnée alors on passe.
si date (range"N") antérieur ou égal à la date mentionnée on prend les informations voulues dans la feuille 'carnet'
- les coller sur la feuille 'écrasement' à la suite range A B C D E

Voici mon code mais je plante dans la boucle ou le message d'erreur est toujours "Loop" sans "Do" ou maintenant "Next" sans "For" 
Sub Ecrasement()
' ecrasement Macro
' pour prendre les references du travail à réaliser dans la semaine.
'
'cette macro récupère le travail à réaliser avant et à la date mentionnée dans l'userform "aecraser"

Dim ii As Integer                    
Dim jj As Integer                  
Dim Debutligne As String
Dim Finligne As String
Dim Ref As String                   'référence interne de l'objet
Dim Client As String                  '
Dim Age As String
Dim Reception As Date
Dim Ecrasement As Date
Dim Dmaxi As Date

'appel de l'userform pour rentrer la DateMax, le Debutligne et la Finligne
    aecraser.Show

'Enregistrer la DateMax
    Dmaxi = aecraser.Dmaxi.Text
    
'coller les dates de la semaine sur la feuille de destination
    ActiveSheet("écrasement").Cells ("A1")
    ActiveCell("F1") = Dmaxi
        
'effacer les information précedente sur la feuille
      Active.Range("A4:K50").ClearContents
      Active.Range ("A4")
 
'on définit la première ligne et la dernière ligne du fichier à traiter
    For ii = Debutligne To Finligne
    jj = 3
'on commence la boucle qui parcourre les objets
       ii = ii + 1   ' ligne sur la feuile de 'carnet'
       jj = jj + 1   ' ligne sur la feuille 'a ecraser'
       
' voir si l'objet est à écraser
    ActiveSheet("Carnet").Range ("E" + CStr(ii))
            If ActiveSheet.Value = "" Then 
            Active.Range("N" + CStr(ii)).Select
          
            If ActiveCell.Value <= DateMAx Then
        
'récupérer la référence et la coller dans la case prévue sur la feuille de calcul
    Active.Range("A" + CStr(ii)).Select
    Ref = ActiveCell.Value                   
'coller la réference
    Sheets("Ecrasement").Select
    ActiveSheet.Range("A" + CStr(jj)).Select
    ActiveCell.Value = Ref

'récupérer le client et le mettre dans la case prévue
    Sheets(Carnet).Select
    ActiveSheet.Range("B" + CStr(ii)).Select
    Client = ActiveCell.Value
'implanter dans la feuille
    Sheets("Ecrasement").Select
    ActiveSheet.Range("B" + CStr(jj)).Select
    ActiveCell.Value = Client

'récupérer la date de reception
    Sheets("carnet").Select
    ActiveSheet.Range("C" + CStr(ii)).Select
    Reception = ActiveCell.Value
'implanter la date de reception
    Sheets("Ecrasement").Select
    ActiveSheet.Range("C" + CStr(jj)).Select
    ActiveCell.Value = Reception

 'récupérer l'Age
    Sheets("carnet").Select
    ActiveSheet.Range("L" + CStr(ii)).Select
    Age = ActiveCell.Value
'implanter l'Age
    Sheets("Ecrasement").Select
    ActiveSheet.Range("D" + CStr(jj)).Select
    ActiveCell.Value = Age

'récupérer la date d'Ecrasement
    Sheets("carnet").Select
    ActiveSheet.Range("C" + CStr(ii)).Select
    Ecrasement = ActiveCell.Value
'implanter la date d'Ecrasement
    Sheets("Ecrasement").Select
    ActiveSheet.Range("E" + CStr(jj)).Select
    ActiveCell.Value = Ecrasement

Next

End Sub


9 réponses

Réponse 1 / 9
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
14 mai 2013 à 09:16
Bonjour,
Il manque un end if (recopie ou pas), l'onglet "écrasement" ou "Ecrasement" ????

Votre code un peu allege, par contre deux choses curieuses ou j'ai mis des ????

a vous de tester, car je n'ai pas vos donnees. 

Sub Ecrasement()
    ' ecrasement Macro
    ' pour prendre les references du travail à réaliser dans la semaine.
    '
    'cette macro récupère le travail à réaliser avant et à la date mentionnée dans l'userform "aecraser"

    Dim ii As Integer, jj As Integer
    Dim Debutligne As String, Finligne As String, Ref As String                 'référence interne de l'objet
    Dim Client As String, Age As String
    Dim Reception As Date, Ecrasement As Date, Dmaxi As Date

    'appel de l'userform pour rentrer la DateMax, le Debutligne et la Finligne
    aecraser.Show

    'Enregistrer la DateMax
    Dmaxi = aecraser.Dmaxi.Text
    
    'coller les dates de la semaine sur la feuille de destination
    Worksheets("écrasement").Cells("F1") = Dmaxi
        
    'effacer les information précedente sur la feuille
    Worksheets("écrasement").Range("A4:K50").ClearContents
 
    'on définit la première ligne et la dernière ligne du fichier à traiter
    For ii = Debutligne To Finligne             '????????????????????????????????????????????
        jj = 3                                            '???????????????????????????????????????????
        'on commence la boucle qui parcourre les objets
        ii = ii + 1   ' ligne sur la feuile de 'carnet'
        jj = jj + 1   ' ligne sur la feuille 'a ecraser'
       
        ' voir si l'objet est à écraser
        With Sheet("Carnet")
            If .Range("E" & ii).Value = "" Then
                 If .Range("N" & ii).Value <= DateMAx Then
        
                'récupérer la référence et la coller dans la case prévue sur la feuille de calcul
                'coller la réference
                Sheets("Ecrasement").Range("A" & jj) = .Range("A" & ii)

                'récupérer le client et le mettre dans la case prévue
                'implanter dans la feuille
                Sheets("Ecrasement").Range("B" & jj) = .Range("B" & ii)

                'récupérer la date de reception
                'implanter la date de reception
                Sheets("Ecrasement").Range("C" & jj) = .Range("C" & ii)

                'récupérer l'Age
                'implanter l'Age
                Sheets("Ecrasement").Range("D" & jj) = .Range("L" & ii)

                'récupérer la date d'Ecrasement
                'implanter la date d'Ecrasement
                Sheets("Ecrasement").Range("E" & jj) = .Range("C" & ii)
            End If
        End With

    Next ii

End Sub


A+
0
Réponse 2 / 9
gilles52300 Messages postés 35 Date d'inscription dimanche 12 mai 2013 Statut Membre Dernière intervention 1 octobre 2018
14 mai 2013 à 12:44
Merci beaucoup pour votre aide.
Pour être allégé, il est allégé... quand j'arriverais à faire ça, je serais content.
Concernant les points d'interrogations,
For ii = Debutligne To Finligne 'definition de la plage de ligne à tester
jj = 3 'début de ligne ou copier les données
Dans une de mes anciennes macro (2006) j'avais fait ceci. Maintenant je ne sais pas si c'est ce qu'il faut faire.

J'ai testé votre code, et j'ai toujours la même erreur de compilation que je n'arrive pas à determiner "End With" sans "With".
0
Réponse 3 / 9
gilles52300 Messages postés 35 Date d'inscription dimanche 12 mai 2013 Statut Membre Dernière intervention 1 octobre 2018
Modifié par gilles52300 le 14/05/2013 à 14:03
Je viens de rajouter une "End If" avant le dernier et la macro démarre. Yesss

maintenant j'ai :
erreur d'execution " 5"
Argument ou appel de procedure incorrect

'coller les dates de la semaine sur la feuille de destination
Worksheets("Ecrasement").Cells("F1") = Dmaxi

Je continue à travailler dessus et je vous tiens au courant dans la journée.
Merci encore.
0
Réponse 4 / 9
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
14 mai 2013 à 19:42
Re,

en effet petit oubli:

Worksheets("Ecrasement").Cells(1, "F") = Dmaxi

ou

Worksheets("Ecrasement").Cells(1, 6) = Dmaxi

bon courage
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 9
gilles52300 Messages postés 35 Date d'inscription dimanche 12 mai 2013 Statut Membre Dernière intervention 1 octobre 2018
Modifié par gilles52300 le 14/05/2013 à 20:08
Merci bien, Je suis en Haïti aussi il y a 6 heures en moins de décalage avec la France.

La macro fonctionne bien maintenant sauf petit soucis que je n'arrive pas à determiner.
Je copie les dates dans la feuille 'Carnet' et sur feuille 'Ecrasement' elle se colle +1jours et 3ans
EX: copié 8/5/13 = Collé 9/5/17 

Sub Ecrasement()
    ' ecrasement Macro
    ' pour prendre les references du travail à réaliser dans la semaine.
    '
    'cette macro récupère le travail à réaliser avant et à la date mentionnée dans l'userform "aecraser"

    Dim ii As Integer, jj As Integer
    Dim Debutligne As String, Finligne As String, Ref As String
    Dim Client As String, Age As String
    Dim Reception As Date, Ecrasement As Date, Dmaxi As String

    'appel de l'userform pour rentrer la DateMax, le Debutligne et la Finligne
    aecraser.Show

    'Enregistrer les données de l'userform
        Dmaxi = aecraser.Dsemaine.Text
        Debutligne = aecraser.Dligne.Text
        Finligne = aecraser.Fligne.Text
    'début de la ligne ou copier les données
        jj = 3
    'coller les dates de la semaine sur la feuille de destination
    Worksheets("Ecrasement").Range("E1") = Dmaxi
        
    'effacer les information précedente sur la feuille
    Worksheets("Ecrasement").Range("A4:G50").ClearContents
 
    'on définit la première ligne et la dernière ligne du fichier à traiter
    For ii = Debutligne To Finligne             'définition des lignes à tester
             jj = jj + 1

     'on commence la boucle qui parcourre les objets
     ' voir si l'objet est à écraser
        With Sheets("Carnet")
                If .Range("E" & ii) <> "" Then
                    jj = jj - 1
                    GoTo finbouc
                End If
        
                If .Range("N" & ii).Value > Dmaxi Then
                    jj = jj - 1
                    GoTo finbouc
                End If
            
                 If .Range("N" & ii).Value <= Dmaxi Then
                'récupérer la référence et implanter dans la case prévue
                Sheets("Ecrasement").Range("A" & jj) = .Range("A" & ii)

                'récupérer le client et implanter dans la case prévue
                Sheets("Ecrasement").Range("B" & jj) = .Range("B" & ii)

                'récupérer la date de reception et implanter dans la case prévue
                Sheets("Ecrasement").Range("C" & jj) = .Range("C" & ii)

                'récupérer l'Age et implanter dans la case prévue
                Sheets("Ecrasement").Range("D" & jj) = .Range("L" & ii)

                'récupérer la date d'Ecrasement et implanter dans la case prévue
                Sheets("Ecrasement").Range("E" & jj) = .Range("N" & ii)
                GoTo finbouc
                End If
            
        End With
finbouc:
    Next ii

End Sub
0
Réponse 6 / 9
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
14 mai 2013 à 21:40
Re,

EX: copié 8/5/13 = Collé 9/5/17 ?????? dans le code, il n'y a pas d'ajout.
0
Réponse 7 / 9
gilles52300 Messages postés 35 Date d'inscription dimanche 12 mai 2013 Statut Membre Dernière intervention 1 octobre 2018
Modifié par gilles52300 le 15/05/2013 à 00:35
ben oui c'est bien la le soucis, c'est que je ne vois pas d'ajout non plus. Alors est-ce que cela ne viendrait pas de la variable? Ne faudrait-il pas ecrire Dim Reception as "autre chose que date?

en regardant sur les forums les erreurs possible, j'ai essayé un truc. Les autres ne fonctionnant pas et en rajoutant "-0" mes dates redeviennent normal 
Sheets("Ecrasement").Range("A" & jj) = .Range("A" & ii) Sheets("Ecrasement").Range("B" & jj) = .Range("B" & ii)
Sheets("Ecrasement").Range("C" & jj) = .Range("C" & ii) - 0
Sheets("Ecrasement").Range("D" & jj) = .Range("L" & ii)
Sheets("Ecrasement").Range("E" & jj) = .Range("N" & ii) - 0


Si quelqu'un peut m'expliquer???????
0
Réponse 8 / 9
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
Modifié par f894009 le 15/05/2013 à 08:34
Bonjour,

Ne faudrait-il pas ecrire Dim Reception non, puisque vous ne l'utilisez pas dans votre code. Pour le "-0", merci de l'astuce, mais je n'ai pas d'explication.
0
Réponse 9 / 9
gilles52300 Messages postés 35 Date d'inscription dimanche 12 mai 2013 Statut Membre Dernière intervention 1 octobre 2018
15 mai 2013 à 13:27
Concernant l'astuce, c'est la moindre de chose que de la partager.
Je te remercie encore de ton aide.
Je reviens sans doute bientôt pour un nouveau besoin d'aide car je m'attaque à plus compliqué, enfin pour moi.
0

Discussions similaires

Transparence en tete et bas de page
Sabrina -
sabrina -

8 réponses
"L'indice n'appartient à la sélection" + VBA
fleur.31 -
geosevda -

2 réponses
Dessiner avec son clavier et avec des lettres
JSS -
Polodu33 -

78 réponses
chaima csc
chaima -
chaima -

1 réponse
Codage de texte
beauté numerique -
beauté numerique -

8 réponses