Macro excel urgent

Signaler
Messages postés
3
Date d'inscription
lundi 2 mars 2009
Statut
Membre
Dernière intervention
17 mars 2009
-
Messages postés
3
Date d'inscription
lundi 2 mars 2009
Statut
Membre
Dernière intervention
17 mars 2009
-
-  cherché les date arivent a la fin apré 15 jours
- Je veux  que l’algorithme me créer une nouvelle feuil
- Je veux pas avoir un message je veux avoir le résultat dans la nouvelle feuil crées déjà
- pour copie les donnée d 'une feuil a une autre (copie juste les resultat de l’algorithme précèdent<?xml:namespace prefix o ns "urn:schemas-microsoft-com:office:office" /??>

 

 

                    Set mafeuille = Sheets.Add(, Sheets(Sheets.Count))

                    mafeuille.Name = "Feuil1"

 

-         cherché les date arivent a la fin apré 15 jours

 

Private Sub Workbook_Open()

  Dim DerLig As Long, Lig As Long, NbJ As Integer

  Dim DateF As Date, DateJ As Date

  Dim Msg As String

  ' récupérer le nombre de jour avant échéance

  NbJ = Sheets("Params").Range("NbJAvt").Value

  DateJ = Format(Now() + NbJ, "dd/mm/yyyy")

  Msg = ""

  ' Avec Etat Inter 28janv09

  With Sheets("Etat Inter 28janv09")

    ' Récupérer la dernière ligne du tableau

    DerLig = .Range("G" & Rows.Count).End(xlUp).Row

    ' Pour chaque ligne on vérifie si écchéance proche

    For Lig = 2 To DerLig

      ' Récupérer la date de la feuille colonne C

      On Error Resume Next

      DateF = Format(.Range("H" & Lig).Value, "dd/mm/yyyy")

      On Error GoTo 0
      ' Vérifier avec <?xml:namespace prefix st1 ns "urn:schemas-microsoft-com:office:smarttags" /??><st1:personname w:st="on" productid="la Date">la Date</st1:personname> du Jour d'échéance + Nb jours d'avance

      If DateF = DateJ Then

        Msg = Msg & Lig & ", "

        ' Mettre en rouge (par exemple) la cellule

        .Range("H" & Lig).Interior.ColorIndex = 3

      End If

    Next Lig

  End With

  If Msg <> "" Then

    ' Supprimer la virgule de la fin

    Msg = Left(Msg, Len(Msg) - 2)

    ' Afficher le message

    MsgBox "Attention, les lignes : " & Msg & " arrivent à la fin du contart dans : " & NbJ & " jour(s)"

  End If

End Sub

Je veux pas avoir un message je veux avoir le résultat dans la nouvelle feuil crées déjà

-pour copie les donnée d 'une feuil a une autre (copie juste les resultat de l’algorithme précèdent

 

Sheets("Etat Inter 28janv09").Select

  ActiveCell.SpecialCells(xlLastCell).Select

  Range(Selection, Cells(1)).Select

  Sheets("Feuil1").Activate ' feuille de destination

  Col = "H"                 ' colonne de la donnée non vide à tester

  NumLig = 0

  With Sheets("Etat Inter 28janv09")     ' feuille source

  NbrLig = .Cells(65536, Col).End(xlUp).Row

  For Lig = 1 To NbrLig

    If .Cells(Lig, Col).Value <> "" Then

      .Cells(Lig, Col).EntireRow.Copy

      NumLig = NumLig + 1

      Cells(NumLig, 1).Select

      ActiveSheet.Paste

    End If

  Next

  End With

 

3 réponses

Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
74
BONJOUR aussi
Tu te crois où ? à l'épicerie du coin ?

Si tu as un problème de programmation, explique-le, un problème à la fois, mais ne compte pas sur les membres de Codes-Sources pour faire ton programme a ta place.

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

<hr />Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)
Messages postés
577
Date d'inscription
vendredi 26 septembre 2008
Statut
Membre
Dernière intervention
20 novembre 2010
4
Fatima,

Ta question est un condensé de ce qu'on n'a plus envie de voir sur ce forum :

- Le titre "Macro Excel Urgent" n'est pas du tout explicite
- Tu n'es pas dans le bon thème ; pour Excel, c'est Visual Basic 6/Langages dérivés/VBA
- Manque de courtoisie, ton impérieux
- Question mal posée, aucun effort de présentation

Pour ces raisons, et pour ne pas encourager ce genre d'attitude, je ne donne pas suite à ta demande.
Messages postés
3
Date d'inscription
lundi 2 mars 2009
Statut
Membre
Dernière intervention
17 mars 2009

re Bonjour,
je suis désolé le programe presque camarche mais je veux juste des modification je maitrise pas le vb se code  il me fai copie de tou le tableu aide moi svp