Sujet Précédent Sujet Suivant

Code vb excel

missnour -  
wilfried_42 Messages postés 912 Statut Contributeur -
Bonjour,
je souhaiterais effectuer une selection variable dune plage de cellule en fonction de la date (si la date arrivent dans 15 jours) faire extraire les donne ver une autre feuil voila le code aide moi svp
Option Explicit

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le le 13/03/2009 par chemaa
'

'
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
Range("H").Select
Selection.Interior.ColorIndex = xlNone
End Sub
Option Explicit
Private Sub Workbook_Open()
Dim DerLig As Long, Lig As Long, NbJ As Integer
Dim DateF As Date, DateJ As Date
Dim NumLig As Long
Dim Col As String
Dim NbrLig As Long
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 H
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

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

End Sub

Configuration: Windows XP
Internet Explorer 6.0

1 réponse

Réponse 1 / 1
wilfried_42 Messages postés 912 Statut Contributeur 245
 
Bonjour

l'utilisation des filtres automatiques pour copier une plage de cellule est franchement la plus rapide
voici un code la date se trouve en colonne C 
Sub Bouton1_QuandClic()
    Dim madate As Date, maplage As Range, macopie As Range
    madate = DateValue("02/03/2009") ' Date sur laquelle je filtre
    Set maplage = Range("A1").CurrentRegion ' sélectionne ma plage de travail
    maplage.AutoFilter field:=3, Criteria1:=madate ' j'effectue mon filtre
    If Range("A65536").End(xlUp).Row > 1 Then ' je teste s'il y a une ligne de correcte
        Set macopie = Range("A2:C" & Range("A65536").End(xlUp).Row).Cells.SpecialCells(xlCellTypeVisible) ' je récupère uniquement les lignes restées visibles suite au filtre
        macopie.Copy Destination:=Sheets("Feuil2").Range("A65536").End(xlUp) ' je copie ces ligne en feuille 2
    End If
    maplage.AutoFilter ' J'enlève les filtre automatique (ni vu ni connu)
End Sub
0