Transfert Données d'une Feuil dans une autre suivant date,fonctionne pas

[MuscatMimi]

Bonjour a tout le Forum

dans le fichier joint,j'ai une Macro qui me copy une ,ou plusieurs lignes de la Feuille Echeancier,dans Chaque une des Feuill Janvier,Février,Mars etc,suivant la Date Col B de la feuil Echeancier

En fait, ça ne me copy que la prémiére ligne ici (B2) 08/04/2011,et si j'ai dans la Col B
d'autres Date au 08/04/2011 ça ne me les copy pas
Comprends pas

Voici la Macro pour Avril

Sub TranfertAvril()
Dim Cell As Range, DerLi As Long
Sheets("Echeancier").Activate
'
For Each Cell In Range("B2:B" & Range("B65536").End(xlUp).Row)
If Cell <= Date And Cell.Offset(, 5) = "" Then

Cell.Offset(, 5) = "X"
With Sheets("Avril")
On Error Resume Next
DerLi = .Range("A65536").End(xlUp).Row + 1
Range("A" & Cell.Row & ":" & "F" & Cell.Row).Copy .Range("A" & DerLi & ":F" & DerLi)
End With
End If
Next
End Sub

Merci a l'avance de votre aide


Cordialement

 

[supercrapaud]

Re : Transfert Données d'une Feuil dans une autre suivant date,fonctionne pas

Bonjour,

dans ta macro ne nomme pas une variable cell, je pense que ça peut prêter à confusion pour VBA. Ensuite quand on regarde, tu devrais peut-être passer par des formules simples. Je ne suis pas sûr d'avoir compris exactement ce que tu cherches à faire dans ton fichier tu devrais nous mettre le résultat que tu souhaites dans ton fichier à l'endroit que tu veux.

 

[MuscatMimi]

Re : Transfert Données d'une Feuil dans une autre suivant date,fonctionne pas

Bonjour supercrapaud(pas mal ton pseudo)

Je trouvé d'ou viens le soucis,
Dans mon Usf AjoutEcheance,Mon DTPicker, n'était pas au format dd/mm/yyyy
pour ma Validation dans la feuille Echeancier

ce qui avait pour but de me valider dans ma Colonne B,feuille Echeancier
la date sous forme de dd/mm/yyyy hh:mm:ss
et c'est pour cela que ça ne me copiait que la premiére ligne
dans ma feuille au Nom de chaque Mois,Avril,Mai, etc

Solution trouvée ouf

Merci de ta contribution

a bientôt

 

[Paritec]

Re : Transfert Données d'une Feuil dans une autre suivant date,fonctionne pas

Bonsoir Christian,
pourrais-tu essayer d'utiliser les balises de code pour rendre la lecture de tes codes plus sympathique
merci d'avance
Papou🙂

 

[MuscatMimi]

Re : Transfert Données d'une Feuil dans une autre suivant date,fonctionne pas

Bonjour Paritec

je croyais que cette fonction, ne fonctionnait plus
milles excuses
tiens je vais essayer

[COLOR=BLUE]Sub[/COLOR] HorizontalScroll()
  [COLOR=BLUE]For Each[/COLOR] C [COLOR=BLUE]In[/COLOR] ActiveSheet.Comments
    C.Visible = [COLOR=BLUE]True[/COLOR]
    C.Shape.Select
    Selection.ShapeRange.AutoShapeType = msoShapeHorizontalScroll
  [COLOR=BLUE]Next[/COLOR] C
[COLOR=BLUE]End Sub[/COLOR]

 

[MuscatMimi]

Re : Transfert Données d'une Feuil dans une autre suivant date,fonctionne pas

Re Bonjour

Me revoila, avec un autre soucis

Dans un Module il y a cette Macro

Sub TranfertJanvier()
'-- Copie Données suivant Date Feuil Col C dans Feuil2
Dim Cell As Range, DerLi As Long
 Sheets("Echeancier").Activate

    For Each Cell In Range("B2:B" & Range("B65536").End(xlUp).Row)
      If Cell <= Date And Cell.Offset(, 5) = "" Then
    
       Cell.Offset(, 5) = "X"
       'Cell.Offset(, -2) = "P"
        With Sheets("Janvier")
       On Error Resume Next
         DerLi = .Range("A65536").End(xlUp).Row + 1
          Range("A" & Cell.Row & ":" & "F" & Cell.Row).Copy .Range("A" & DerLi & ":F" & DerLi)
         End With
      End If
      Next
      End Sub

Sub TranfertFevrier()
'-- Copie Données suivant Date Feuil Col C dans Feuil2
Dim Cell As Range, DerLi As Long
 Sheets("Echeancier").Activate

    For Each Cell In Range("B2:B" & Range("B65536").End(xlUp).Row)
      If Cell <= Date And Cell.Offset(, 5) = "" Then
    
       Cell.Offset(, 5) = "X"
       'Cell.Offset(, -2) = "P"
        With Sheets("Fevrier")
       On Error Resume Next
         DerLi = .Range("A65536").End(xlUp).Row + 1
          Range("A" & Cell.Row & ":" & "F" & Cell.Row).Copy .Range("A" & DerLi & ":F" & DerLi)
         End With
      End If
      Next
      End Sub

Sub TranfertMars()
'-- Copie Données suivant Date Feuil Col C dans Feuil2
Dim Cell As Range, DerLi As Long
 Sheets("Echeancier").Activate

    For Each Cell In Range("B2:B" & Range("B65536").End(xlUp).Row)
      If Cell <= Date And Cell.Offset(, 5) = "" Then
    
       Cell.Offset(, 5) = "X"
       'Cell.Offset(, -2) = "P"
        With Sheets("Mars")
       On Error Resume Next
         DerLi = .Range("A65536").End(xlUp).Row + 1
          Range("A" & Cell.Row & ":" & "F" & Cell.Row).Copy .Range("A" & DerLi & ":F" & DerLi)
         End With
      End If
      Next
      End Sub

Sub TranfertAvril()
'-- Copie Données suivant Date Feuil Col C dans Feuil2
Dim Cell As Range, DerLi As Long
 Sheets("Echeancier").Activate
'
    For Each Cell In Range("B2:B" & Range("B65536").End(xlUp).Row)
      If Cell <= Date And Cell.Offset(, 5) = "" Then
    
       Cell.Offset(, 5) = "X"
       'Cell.Offset(, -2) = "P"
        With Sheets("Avril")
       On Error Resume Next
         DerLi = .Range("A65536").End(xlUp).Row + 1
          Range("A" & Cell.Row & ":" & "F" & Cell.Row).Copy .Range("A" & DerLi & ":F" & DerLi)
         End With
      End If
      Next
      End Sub
 
Sub TranfertMai()
'-- Copie Données suivant Date Feuil Col C dans Feuil2
Dim Cell As Range, DerLi As Long
 Sheets("Echeancier").Activate

    For Each Cell In Range("B2:B" & Range("B65536").End(xlUp).Row)
      If Cell <= Date And Cell.Offset(, 5) = "" Then
    
       Cell.Offset(, 5) = "X"
       'Cell.Offset(, -2) = "P"
        With Sheets("Mai")
       On Error Resume Next
         DerLi = .Range("A65536").End(xlUp).Row + 1
          Range("A" & Cell.Row & ":" & "F" & Cell.Row).Copy .Range("A" & DerLi & ":F" & DerLi)
         End With
      End If
      Next
      End Sub
      
      Sub TranfertJuin()
'-- Copie Données suivant Date Feuil Col C dans Feuil2
Dim Cell As Range, DerLi As Long
 Sheets("Echeancier").Activate

    For Each Cell In Range("B2:B" & Range("B65536").End(xlUp).Row)
      If Cell <= Date And Cell.Offset(, 5) = "" Then
    
       Cell.Offset(, 5) = "X"
       'Cell.Offset(, -2) = "P"
        With Sheets("Juin")
       On Error Resume Next
         DerLi = .Range("A65536").End(xlUp).Row + 1
          Range("A" & Cell.Row & ":" & "F" & Cell.Row).Copy .Range("A" & DerLi & ":F" & DerLi)
         End With
      End If
      Next
      End Sub

dans ThisWorkBook_Open, si je met

TranfertJanvier
TranfertFevrier
TranfertMars
TranfertAvril

la Macro ci-dessus,ne ce déclenche pas

Ou est mon erreur???,la j'ai vraiment cherchez,mais pas trouvé


a plus Merci