macro excel urgent

Question

- 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 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 la Date 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

cs_Jack · Answer

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)

cs_Orohena · Answer

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.

missnour26 · Answer

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

Macro excel urgent

3 réponses

Votre réponse

Discussions similaires