Copie cellulle avec ligne integrale si cellule non vide

[DUPONTEL]

bonjour à tous
voilà mon souci
j'ai un tableau en a11 P34
en colonne F si la cellule est renseignée par une date je voudrais que cette ligne entière soit copiée à partir de la ligne 41 de la même page
Egalement que les lignes recopiées soient triés par dates c'est à dire qu'elles apparaissent en ordre du plus ancien en haut à la plus actuelle en bas .
je transmets mon exemple
en vous remerciant par avance

 

[phlaurent55]

Re : Copie cellulle avec ligne integrale si cellule non vide

Bonjour Dupontel,

voir fichier joint ( réalisé à l'aide de l'enregistreur de macro version 2007 )

à+
Philippe

 

[mapomme]

Re : Copie cellulle avec ligne integrale si cellule non vide

Bonjou DUPONTEL, phlaurent55 ,


Un autre essai à partir d'un de mes codes existants. On convertit (du moins on essaye) les dates (sous format date ou texte - avec ou sans heure) en format date sans heure. On ne copie les lignes que dans si la colonne F se trouve une date correcte. Le code est dans le module de la feuille "Feuil1".

Sub extraction()
Dim xrg As Range, i&, n&, d, dat As Date

Application.ScreenUpdating = False

'nettoyage des précédents résultats
Range(Cells(40, "a"), Cells(40, "p")).CurrentRegion.Clear
Range(Cells(11, "a"), Cells(11, "p")).Copy Cells(40, "a")

n = -1
For i = 12 To 34
  If IsDate(Cells(i, "f")) Then
'   ce peut être une date
    dat = CDate(Cells(i, "f"))
    Cells(i, "f").ClearContents
    Cells(i, "f").NumberFormat = "General"
    Cells(i, "f") = Int(dat)
    n = n + 1
    Range(Cells(i, "a"), Cells(i, "p")).Copy Cells(41 + n, "a")
  End If
Next i
'tri
Range("a40:p40").Resize(n + 2).Sort key1:=Range("f40"), order1:=xlAscending, Header:=xlYes
Range("a40").Select

End Sub

 

[DUPONTEL]

Re : Copie cellulle avec ligne integrale si cellule non vide

bonsoir
merci de vos reponses
pour la reponse de philippe j'ai un blocage avec vbe qui s'ouvre
ligne jaune sur ceci ;
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear

mais en arrêtant le deboggage , la copie est faite ..je suis avec xl2000
as tu une idée pour cette erreur?
cordialement

 

[DUPONTEL]

Re : Copie cellulle avec ligne integrale si cellule non vide

Bonsoir mapomme
merci pour ton exemple qui a l'air très bon
une question : je me rends compte que l'extraction pourrait faire trop de ligne sur la meme feuille pour avoir une vue globale , est il possoible de mettre cette extraction sur une autre feuille à ton avis?
en te remerciant pour ta réponse

 

[ROGER2327]

Re : Copie cellulle avec ligne integrale si cellule non vide

Bonsoir à tous.

Abondance de biens ne nuit pas. Une autre solution, avec, compte tenu du message #5, report de l'extraction sur une autre feuille.​

Sub toto()
Dim i&, j&, k&, r, l(), Plg As Range
ReDim l(1, 0)
    With Feuil1
        With .[A11].Resize(BasDroite(.[F11], 34, "F").Rows.Count, .Columns("P").Column).Cells
            'J'utilise la fonction BasDroite pour la sélection précise d'une plage de données.
            'Elle n'a rien à voir avec le problème. (Son code est dans le module Service.)

            'Relevé des numéros de lignes à copier :

            For i = 2 To .Rows.Count
                If IsDate(.Cells(i, 6)) Then k = k + 1: ReDim Preserve l(1, k): l(0, k) = .Cells(i, 6).Value: l(1, k) = i
            Next

            'Classement par date d'ancienneté décroissante :

            For i = 1 To k - 1: r = l(0, i): For j = i + 1 To k
                If l(0, j) < r Then l(0, i) = l(0, j): l(0, j) = r: r = l(1, i): l(1, i) = l(1, j): l(1, j) = r: r = l(0, i)
            Next j, i

            'Report des lignes dans la feuille Feuil2 :

            Set Plg = Feuil2.[A1]
            With Application: .ScreenUpdating = 0: .EnableEvents = 0: .Calculation = -4135: End With
            Plg.CurrentRegion.Clear
            .Rows(1).Copy Destination:=Plg
            For i = 1 To k
                .Rows(l(1, i)).Copy Destination:=Plg.Offset(i)
            Next
            Plg.Columns("A").Resize(, .Columns.Count).EntireColumn.AutoFit

            'Facultatif :

            Plg.Parent.Activate

            With Application: .Calculation = -4105: .EnableEvents = 1: .ScreenUpdating = 1: End With
        End With
    End With
End Sub

Bonne nuit.


ℝOGER2327
#7696

Lundi 2 Sable 142 (Saint Doublemain, idéologue - fête Suprême Quarte)
12 Frimaire An CCXXIII, 9,8715h - raifort
2014-W49-2T23:41:29Z

 

[mapomme]

Re : Copie cellulle avec ligne integrale si cellule non vide

Bonjour DUPONTEL, ROGER2327,

Une adaptation pour afficher le tableau sur une autre feuille que le tableau source.
Le code est maintenant dans le module1.
Il faut indiquer dans le code les noms des feuilles source et destination.
Une confirmation du traitement est demandée.

 

[DUPONTEL]

Re : Copie cellulle avec ligne integrale si cellule non vide

bonjour
merci à vous pour ces reponses c'est la manip que je souhaitais
juste une chose
est il possible d'avoir en feuil2 le tableau commencant en A11 plutôt qu'en a1
si cela est possible ce serait super

 

[Si...]

Re : Copie cellulle avec ligne integrale si cellule non vide

salut

j'en profite pour donner cette solution à placer dans la page de code de la feuille cible

Private Sub Worksheet_Activate()
  Dim L As Long
  L = [Ta].Rows.Count + 11 'Ta : tableau de la plage source
   Rows("11:" & L).Delete
  [Ta].Copy [A11]
  Range("A11:P" & L).Sort [F11], 2
  L = Range("F11:F" & L).Find("").Row
  Rows(L & ":" & 65000).Delete
End Sub

 

[ROGER2327]

Re : Copie cellulle avec ligne integrale si cellule non vide

Re...

(...)
est il possible d'avoir en feuil2 le tableau commencant en A11 plutôt qu'en a1
si cela est possible ce serait super

C'est !​

Bonne journée.


ℝOGER2327
#7697

Mardi 3 Sable 142 (Saint Phlegmon, doctrinaire - fête Suprême Quarte)
13 Frimaire An CCXXIII, 4,7364h - cèdre
2014-W49-3T11:22:02Z

 

[mapomme]

Re : Copie cellulle avec ligne integrale si cellule non vide

Bonsoir DUPONTEL,

Modification de la procédure extraction() afin de placer le tableau dans la cellule cible désirée.
L'adresse de la cellule cible (A11 ou une autre adresse) est à indiquer dans le code.