selection d'informations à coller pour impression Résolu

Question

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

Configuration: Mac OS X Lion (10.7.5) / Chrome 26.0.1410.65

f894009 · Answer

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+

gilles52300 · Answer

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".

gilles52300 · Answer

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.

f894009 · Answer

Re,

en effet petit oubli:

Worksheets("Ecrasement").Cells(1, "F") = Dmaxi

ou

Worksheets("Ecrasement").Cells(1, 6) = Dmaxi

bon courage

gilles52300 · Answer

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

f894009 · Answer

Re,

EX: copié 8/5/13 = Collé 9/5/17 ?????? dans le code, il n'y a pas d'ajout.

gilles52300 · Answer

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???????

f894009 · Answer

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.

gilles52300 · Answer

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.

Selection d'informations à coller pour impression

9 réponses

Discussions similaires

Newsletters