Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Copier_VBA

Copier_VBA

18 réponses
Avatar
Jean Berti
Bonjour à tous

En colonne des dates (01/01/2007) triées.
En B...AS des valeurs numèriques.
Comment recupérer la ligne du dernier jour du mois de janvier par exemple
( sachant que le dernier jour n'est pas forcemment le 31) et copier cette
ligne sur feuille 2 par exemple.
Merci d'avance

Jean Berti
Signaler un problème avec ce contenu

8 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
isabelle
Bonjour tout le monde

En effet, la formule initiale aurait oublié la ligne du 12 avril
suivie de la ligne du 15 mai.



Là, je dois dire que je ne comprends pas du tout :-

moi non plus, la ligne c'etant transformer en les lignes :-(


isabelle


Avatar
Jean Berti
Bonjour Trirème

Je joins une copie du fichier.
Si possible je voudrais copier uniquement les valeurs.
http://cjoint.com/?irnhVMQfvo

Merci beaucoup

Jean Berti

"Trirème" a écrit dans le message de news:




Cela fonctionne correctement sauf que pour moi les mois ne font pas tous
30
ou 31 jours.
MaDate = DateSerial(Année, Mois + 1, 0)
J'avais par JB récupéré cette formule matricielle
=MAX(SI(MOIS($A$7:$A$1000)=LIGNE();SI(ANNEE($A$7:$A$1000) 07;$A$7:$A$1000;0)))
LIGNE=1 pour Janvier
Comment l'adapter à ta macro?


Pour le coup, c'est moi qui n'ai rien compris. Je pensais que tu cherchais
les lignes correspondant à la date du dernier jour du mois alors que
visiblement tu cherches les lignes avant le passage au mois suivant.
Dans ce cas la macro de cousinhub fonctionne si tu changes :
If Day(cel) > Day(cel.Offset(1, 0)) Then cel.EntireRow.Copy _
Sheets("Feuil2").[a65000].End(xlUp).Offset(1, 0)
par :
If Month(cel) <> Month(cel.Offset(1, 0)) Then cel.EntireRow.Copy _
Sheets("Feuil2").[a65000].End(xlUp).Offset(1, 0)

En effet, la formule initiale aurait oublié la ligne du 12 avril suivie de
la ligne du 15 mai. Ce code suppose comme tu le précisais que les données
soient triées.
Dans les deux cas la dernière ligne est sélectionnée aussi, même si par la
suite tu ajoutes en dessous des données pour le même mois.

Pour le résultat de la copie, précise si tu veux garder les formules ou si
tu veux un collage des valeurs.

Cordialement,
Trirème



Avatar
Trirème
En voyant le jeu de données fourni par Jean ma remarque n'est plus pertinente.
J'avais imaginé que les données n'étaient pas forcément régulières :
12/01/2007
25/01/2007
03/02/2007
18/02/2007
19/02/2007
04/03/2007
14/03/2007 <- Dernière ligne du mois de mars pourtant 14 est inférieur à 17
17/04/2007
22/04/2007
30/04/2007


Bonjour Trirème

Je joins une copie du fichier.
Si possible je voudrais copier uniquement les valeurs.
http://cjoint.com/?irnhVMQfvo


Je te propose ce code pour reconstituer ta Feuil2 récapitulative à partir de
Feuil1 :

Sub Lignes_fin_de_mois()
' Adapter avec tes propres noms de feuilles et plages

' Recréer le contenu de Feuil2
Sheets("Feuil2").Cells.ClearContents
Sheets("Feuil1").[A1:AR1].Copy Sheets("Feuil2").[a1]
Sheets("Feuil2").Shapes.SelectAll
Selection.Delete

' Repérer et copier les lignes précédant le changement de mois
With Sheets("Feuil1")
For Each cel In .Range("A7:A" & .Range("A65536").End(xlUp).Row)
If Month(cel) <> Month(cel.Offset(1, 0)) And Not
IsEmpty(cel.Offset(1, 0)) Then _
Sheets("Feuil2").[a65000].End(xlUp).EntireRow.Offset(1, 0) =
cel.EntireRow.Value
Next cel
End With
End Sub

Et cet autre code pour n'ajouter que la dernière ligne de l'avant dernier
mois.
Essaie de l'exécuter 2 fois de suite.

Sub Derniere_Ligne_fin_de_mois()
' Adapter avec tes propres noms de feuilles et plages

' La Feuil2 est conservée, on ne fait que l'enrichir

' Repérer et copier la dernière ligne précédant un changement de mois
With Sheets("Feuil1")
Lmin = 7: Lmax = .Range("a65536").End(xlUp).Row
For L = Lmax To Lmin Step -1
Set cel = .Range("A" & L)
If Month(cel) <> Month(cel.Offset(1, 0)) And Not
IsEmpty(cel.Offset(1, 0)) Then
' Cette ligne n'est-elle pas déjà dans Feuil2 (macro déjà
exécutée) ?
If IsError(Application.Match(cel, Sheets("Feuil2").Range("A2:A"
& _
.Range("A65536").End(xlUp).Row), 0)) Then
Sheets("Feuil2").[a65000].End(xlUp).EntireRow.Offset(1, 0) =
cel.EntireRow.Value
Else
MsgBox "La dernière ligne du mois précédent est déjà dans la
table récapitulative !"
End If
Exit Sub
End If
Next L
End With
End Sub

Cordialement,
Trirème

Avatar
Jean Berti
Re Trirème

Les 2 macros me donnent erreur de compilation
sub ou fonction non définie.
If Month(cel) <> Month(cel.Offset(1, 0)) And NotIsEmpty(cel.Offset(1, 0))
Au secours!!!
J'avoue que je ne comprends rien

Jean Berti

"Trirème" a écrit dans le message de news:

En voyant le jeu de données fourni par Jean ma remarque n'est plus
pertinente.
J'avais imaginé que les données n'étaient pas forcément régulières :
12/01/2007
25/01/2007
03/02/2007
18/02/2007
19/02/2007
04/03/2007
14/03/2007 <- Dernière ligne du mois de mars pourtant 14 est inférieur à
17
17/04/2007
22/04/2007
30/04/2007


Bonjour Trirème

Je joins une copie du fichier.
Si possible je voudrais copier uniquement les valeurs.
http://cjoint.com/?irnhVMQfvo


Je te propose ce code pour reconstituer ta Feuil2 récapitulative à partir
de
Feuil1 :

Sub Lignes_fin_de_mois()
' Adapter avec tes propres noms de feuilles et plages

' Recréer le contenu de Feuil2
Sheets("Feuil2").Cells.ClearContents
Sheets("Feuil1").[A1:AR1].Copy Sheets("Feuil2").[a1]
Sheets("Feuil2").Shapes.SelectAll
Selection.Delete

' Repérer et copier les lignes précédant le changement de mois
With Sheets("Feuil1")
For Each cel In .Range("A7:A" & .Range("A65536").End(xlUp).Row)
If Month(cel) <> Month(cel.Offset(1, 0)) And Not
IsEmpty(cel.Offset(1, 0)) Then _
Sheets("Feuil2").[a65000].End(xlUp).EntireRow.Offset(1, 0) > cel.EntireRow.Value
Next cel
End With
End Sub

Et cet autre code pour n'ajouter que la dernière ligne de l'avant dernier
mois.
Essaie de l'exécuter 2 fois de suite.

Sub Derniere_Ligne_fin_de_mois()
' Adapter avec tes propres noms de feuilles et plages

' La Feuil2 est conservée, on ne fait que l'enrichir

' Repérer et copier la dernière ligne précédant un changement de mois
With Sheets("Feuil1")
Lmin = 7: Lmax = .Range("a65536").End(xlUp).Row
For L = Lmax To Lmin Step -1
Set cel = .Range("A" & L)
If Month(cel) <> Month(cel.Offset(1, 0)) And Not
IsEmpty(cel.Offset(1, 0)) Then
' Cette ligne n'est-elle pas déjà dans Feuil2 (macro déjà
exécutée) ?
If IsError(Application.Match(cel, Sheets("Feuil2").Range("A2:A"
& _
.Range("A65536").End(xlUp).Row), 0)) Then
Sheets("Feuil2").[a65000].End(xlUp).EntireRow.Offset(1, 0)
cel.EntireRow.Value
Else

MsgBox "La dernière ligne du mois précédent est déjà dans
la
table récapitulative !"
End If
Exit Sub
End If
Next L
End With
End Sub

Cordialement,
Trirème



Avatar
Trirème
Arrrgghhhh !!!
Je passe par l'interface microsoft qui tronque les lignes au plus court
Il fallait lire ....And Not IsEmpty(cel.Offset(1, 0))
avec une espace entre le 'Not' et le 'IsEmpty'
...
Et comment va la bourse aujourd'hui ?

Trirème

Re Trirème

Les 2 macros me donnent erreur de compilation
sub ou fonction non définie.
If Month(cel) <> Month(cel.Offset(1, 0)) And NotIsEmpty(cel.Offset(1, 0))
Au secours!!!
J'avoue que je ne comprends rien

Jean Berti

"Trirème" a écrit dans le message de news:

En voyant le jeu de données fourni par Jean ma remarque n'est plus
pertinente.
J'avais imaginé que les données n'étaient pas forcément régulières :
12/01/2007
25/01/2007
03/02/2007
18/02/2007
19/02/2007
04/03/2007
14/03/2007 <- Dernière ligne du mois de mars pourtant 14 est inférieur à
17
17/04/2007
22/04/2007
30/04/2007


Bonjour Trirème

Je joins une copie du fichier.
Si possible je voudrais copier uniquement les valeurs.
http://cjoint.com/?irnhVMQfvo


Je te propose ce code pour reconstituer ta Feuil2 récapitulative à partir
de
Feuil1 :

Sub Lignes_fin_de_mois()
' Adapter avec tes propres noms de feuilles et plages

' Recréer le contenu de Feuil2
Sheets("Feuil2").Cells.ClearContents
Sheets("Feuil1").[A1:AR1].Copy Sheets("Feuil2").[a1]
Sheets("Feuil2").Shapes.SelectAll
Selection.Delete

' Repérer et copier les lignes précédant le changement de mois
With Sheets("Feuil1")
For Each cel In .Range("A7:A" & .Range("A65536").End(xlUp).Row)
If Month(cel) <> Month(cel.Offset(1, 0)) And Not
IsEmpty(cel.Offset(1, 0)) Then _
Sheets("Feuil2").[a65000].End(xlUp).EntireRow.Offset(1, 0) > > cel.EntireRow.Value
Next cel
End With
End Sub

Et cet autre code pour n'ajouter que la dernière ligne de l'avant dernier
mois.
Essaie de l'exécuter 2 fois de suite.

Sub Derniere_Ligne_fin_de_mois()
' Adapter avec tes propres noms de feuilles et plages

' La Feuil2 est conservée, on ne fait que l'enrichir

' Repérer et copier la dernière ligne précédant un changement de mois
With Sheets("Feuil1")
Lmin = 7: Lmax = .Range("a65536").End(xlUp).Row
For L = Lmax To Lmin Step -1
Set cel = .Range("A" & L)
If Month(cel) <> Month(cel.Offset(1, 0)) And Not
IsEmpty(cel.Offset(1, 0)) Then
' Cette ligne n'est-elle pas déjà dans Feuil2 (macro déjà
exécutée) ?
If IsError(Application.Match(cel, Sheets("Feuil2").Range("A2:A"
& _
.Range("A65536").End(xlUp).Row), 0)) Then
Sheets("Feuil2").[a65000].End(xlUp).EntireRow.Offset(1, 0)
cel.EntireRow.Value
Else


MsgBox "La dernière ligne du mois précédent est déjà dans
la
table récapitulative !"
End If
Exit Sub
End If
Next L
End With
End Sub

Cordialement,
Trirème









Avatar
Jean Berti
CA MARCHE!!!!
Merci infiniment
Juste encore c'est normal qu'il ne prend pas en compte le mois d'aout (dates
jusqu'au 16/08/2007)?
La bourse avait bien démarré (+3%), mais à l'ouverture US (+1%)
Cordialement

Jean Berti

"Trirème" a écrit dans le message de news:

Arrrgghhhh !!!
Je passe par l'interface microsoft qui tronque les lignes au plus court
Il fallait lire ....And Not IsEmpty(cel.Offset(1, 0))
avec une espace entre le 'Not' et le 'IsEmpty'
...
Et comment va la bourse aujourd'hui ?

Trirème

Re Trirème

Les 2 macros me donnent erreur de compilation
sub ou fonction non définie.
If Month(cel) <> Month(cel.Offset(1, 0)) And NotIsEmpty(cel.Offset(1, 0))
Au secours!!!
J'avoue que je ne comprends rien

Jean Berti

"Trirème" a écrit dans le message de news:

En voyant le jeu de données fourni par Jean ma remarque n'est plus
pertinente.
J'avais imaginé que les données n'étaient pas forcément régulières :
12/01/2007
25/01/2007
03/02/2007
18/02/2007
19/02/2007
04/03/2007
14/03/2007 <- Dernière ligne du mois de mars pourtant 14 est inférieur
à
17
17/04/2007
22/04/2007
30/04/2007


Bonjour Trirème

Je joins une copie du fichier.
Si possible je voudrais copier uniquement les valeurs.
http://cjoint.com/?irnhVMQfvo


Je te propose ce code pour reconstituer ta Feuil2 récapitulative à
partir
de
Feuil1 :

Sub Lignes_fin_de_mois()
' Adapter avec tes propres noms de feuilles et plages

' Recréer le contenu de Feuil2
Sheets("Feuil2").Cells.ClearContents
Sheets("Feuil1").[A1:AR1].Copy Sheets("Feuil2").[a1]
Sheets("Feuil2").Shapes.SelectAll
Selection.Delete

' Repérer et copier les lignes précédant le changement de mois
With Sheets("Feuil1")
For Each cel In .Range("A7:A" & .Range("A65536").End(xlUp).Row)
If Month(cel) <> Month(cel.Offset(1, 0)) And Not
IsEmpty(cel.Offset(1, 0)) Then _
Sheets("Feuil2").[a65000].End(xlUp).EntireRow.Offset(1, 0)
cel.EntireRow.Value
Next cel



End With
End Sub

Et cet autre code pour n'ajouter que la dernière ligne de l'avant
dernier
mois.
Essaie de l'exécuter 2 fois de suite.

Sub Derniere_Ligne_fin_de_mois()
' Adapter avec tes propres noms de feuilles et plages

' La Feuil2 est conservée, on ne fait que l'enrichir

' Repérer et copier la dernière ligne précédant un changement de mois
With Sheets("Feuil1")
Lmin = 7: Lmax = .Range("a65536").End(xlUp).Row
For L = Lmax To Lmin Step -1
Set cel = .Range("A" & L)
If Month(cel) <> Month(cel.Offset(1, 0)) And Not
IsEmpty(cel.Offset(1, 0)) Then
' Cette ligne n'est-elle pas déjà dans Feuil2 (macro déjà
exécutée) ?
If IsError(Application.Match(cel,
Sheets("Feuil2").Range("A2:A"
& _
.Range("A65536").End(xlUp).Row), 0)) Then
Sheets("Feuil2").[a65000].End(xlUp).EntireRow.Offset(1,
0)
cel.EntireRow.Value
Else



MsgBox "La dernière ligne du mois précédent est déjà
dans
la
table récapitulative !"
End If
Exit Sub
End If
Next L
End With
End Sub

Cordialement,
Trirème












Avatar
Trirème

CA MARCHE!!!!
Merci infiniment
Juste encore c'est normal qu'il ne prend pas en compte le mois d'aout (dates
jusqu'au 16/08/2007)?
Oui ! Je me demandais, à quel moment tu voulais lancer la macro. Tous les

jours ? Dans ce cas, il faut utiliser le 1er code fourni qui recrée
entièrement l'onglet Feuil2 (avec une nouvelle dernière ligne de Feuil1,
celle que tu ajoutes tous les jours où tu reçois les cotations).

Dans ce cas reprend le 1er code en remplaçant :
If Month(cel) <> Month(cel.Offset(1, 0)) And Not
IsEmpty(cel.Offset(1, 0)) Then _
Sheets("Feuil2").[a65000].End(xlUp).EntireRow.Offset(1, 0) =
cel.EntireRow.Value


par :
If Month(cel) <> Month(cel.Offset(1, 0)) Then _
Sheets("Feuil2").[a65000].End(xlUp).EntireRow.Offset(1, 0) = _
cel.EntireRow.Value

Cordialement,
Trirème

Avatar
Jean Berti
Mon cher Trirème

Toute la famille , les amis , le département se joingnent à moi pour te
remercier pour ta proc qui marche à merveille.
Si j'étais une fille, je crois que....
Merci encore de ton dévouement et de ta patience.

Jean Berti
"Trirème" a écrit dans le message de news:




CA MARCHE!!!!
Merci infiniment
Juste encore c'est normal qu'il ne prend pas en compte le mois d'aout
(dates
jusqu'au 16/08/2007)?
Oui ! Je me demandais, à quel moment tu voulais lancer la macro. Tous les

jours ? Dans ce cas, il faut utiliser le 1er code fourni qui recrée
entièrement l'onglet Feuil2 (avec une nouvelle dernière ligne de Feuil1,
celle que tu ajoutes tous les jours où tu reçois les cotations).

Dans ce cas reprend le 1er code en remplaçant :
If Month(cel) <> Month(cel.Offset(1, 0)) And Not
IsEmpty(cel.Offset(1, 0)) Then _
Sheets("Feuil2").[a65000].End(xlUp).EntireRow.Offset(1, 0) > cel.EntireRow.Value


par :
If Month(cel) <> Month(cel.Offset(1, 0)) Then _
Sheets("Feuil2").[a65000].End(xlUp).EntireRow.Offset(1, 0) = _
cel.EntireRow.Value

Cordialement,
Trirème




1 2