× Aidez la recherche contre le COVID-19 avec votre ordi ! Rejoignez l'équipe PC Astuces Folding@home
 > Tous les forums > Forum Bureautique
 Feuille récap dans un autre répertoire!!!Sujet résolu
Ajouter un message à la discussion
Page : [1] 
Page 1 sur 1
loloheureux
  Posté le 20/06/2008 @ 17:56 
Aller en bas de la page 
Petit astucien

bonjour a tous,
j'ai un ptit souci, rien de grave...
J'aimerais envoyer les données de mes tableaux dans un classeur du meme repertoire nommer Récap dans la feuille qui s'apelle Recap_année

mon code suivant marche bien sur mon classeur de saisie commande avec cette feuille qui s'apelle Recap_année mais maintenant j'aimerais enlever cette feuille et la mettre dans mon nouveau repertoire nommer Récap.

Coment je dois modifier ce code...et le top serait que celui-ci soit fermer lors de l'archivage(le classeur!!)....

merci de votre aide
lolo


Sub Archives()
'
' Archives Macro


Jjour = Range("B1")
For Each cel In Sheets("Recap_année").Range("A:A")
If cel.Value = Jjour Then
MsgBox ("Journée déjà archivée.")
Exit Sub
End If
Next
ligmax = Sheets("Recap_année").Range("A65000").End(xlUp).Row + 1
cible = "A" & ligmax & ":A" & ligmax + 10
Sheets("Recap_année").Range("A" & ligmax & ":A" & ligmax + 10) = Jjour
Range("B3:L3,B10:L10,b11:l11").Copy
Sheets("Recap_année").Select
Range("B" & ligmax).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Application.CutCopyMode = False

Sheets("Calcul").Select
ligmax = Sheets("Recap_année").Range("A65000").End(xlUp).Row + 1
cible = "A" & ligmax & ":A" & ligmax + 7
Sheets("Recap_année").Range("A" & ligmax & ":A" & ligmax + 7) = Jjour
Range("i15:p15,i16:p16,i17:p17").Copy
Sheets("Recap_année").Select
Range("B" & ligmax).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Application.CutCopyMode = False

Sheets("Calcul").Select
ligmax = Sheets("Recap_année").Range("A65000").End(xlUp).Row + 1
cible = "A" & ligmax & ":A" & ligmax + 7
Sheets("Recap_année").Range("A" & ligmax & ":A" & ligmax + 7) = Jjour
Range("i19:p19,i20:p20,i21:p21").Copy
Sheets("Recap_année").Select
Range("B" & ligmax).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Application.CutCopyMode = False

Sheets("Calcul").Select
MsgBox ("Journée archivée.")

End Sub



Modifié par loloheureux le 20/06/2008 17:59
Publicité
galopin01
 Posté le 21/06/2008 à 11:45 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Astucien

Bonjour,

voir ici

A+



Modifié par galopin01 le 21/06/2008 12:11
loloheureux
 Posté le 21/06/2008 à 19:41 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

bonsoir Galopin....

merci de ton aide...beaucoup de travail ce week-end..pas trop le temps de m'y pencher...mais dès lundi je te tiens au courant...

oui je m'apercois que je n'ai pas ete tres clair dans ma demande

bon week-end

lolo

amicalement

loloheureux
 Posté le 22/06/2008 à 11:45 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

galopin01 a écrit :

Bonjour,

voir ici

A+

bonjour Galopin,

merci de ton aide si précieuse.....j'ai appris pas mal en peu de temps avec vous...

le code que vous avez modifier marche très bien avec sub archives() ....la pas de soucis du moment que la feuille récap_année est dans le même classeur nommée "Commande pain_v3"

du moment que j'enlève la feuille récap_année et que je la mets dans le nouveau classeur appelé "Récap", la il ya un soucis au moment du transfert.

le transfert se fait bien mais les données ne sont pas bonnes(voir en rouge dans le feuille récap_année)

je joint le fichier c'est plus facile a expliquer, je pense........

http://cjoint.com/?gwlTo3iFw8

merci

lolo



Modifié par loloheureux le 22/06/2008 11:46
galopin01
 Posté le 22/06/2008 à 14:45 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Astucien

bonjour,

Je ne sais pas trop comment tu as obtenu ça !

Dans la récap efface les dernière données transférées. et referme le classeur Récap

Dans le classeur Saisie commande copier et lancer cette macro :

Sub Galopin()
ActiveWorkbook.Names.Add "SDat", CDate(Date + 1), True
End Sub

... Puis supprimer cette macro. (sert à forcer l'archivage quelle que soit la date en B1)

Lancer ensuite la macro NewArchive() à partir de la feuille Commande : Yapa de raison que ça ne marche pas (En tout cas, ça marche très bien chez moi)

A+



Modifié par galopin01 le 22/06/2008 14:53
loloheureux
 Posté le 23/06/2008 à 05:10 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

galopin01 a écrit :

bonjour,

Je ne sais pas trop comment tu as obtenu ça !

Dans la récap efface les dernière données transférées. et referme le classeur Récap

Dans le classeur Saisie commande copier et lancer cette macro :

Sub Galopin()
ActiveWorkbook.Names.Add "SDat", CDate(Date + 1), True
End Sub

... Puis supprimer cette macro. (sert à forcer l'archivage quelle que soit la date en B1)

Lancer ensuite la macro NewArchive() à partir de la feuille Commande : Yapa de raison que ça ne marche pas (En tout cas, ça marche très bien chez moi)

A+

re,

j'ai bien fait cette procédure avant et je viens de la refaire.... et toujours le même résultat...

je ne comprends pkoi chez toi cela marche et pas chez moi....j'ai essayé sous excel 2003 et 2007 et c'est pareil..

ou est le probème? je suis sur que c'est pas grand chose mais bon....c'est embêtant..

A+

lolo

galopin01
 Posté le 23/06/2008 à 07:13 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Astucien

Je serai absent aujourd'hui je reverrai ça ce soir !

A+

galopin01
 Posté le 23/06/2008 à 19:33 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Astucien

bonsoir,

Je t'ai bétonné ça un peu mieux ! Remplacer la Sub NewArchive() comme suit :

Sub NewArchive()
Dim WsO As Worksheet
Application.ScreenUpdating = False
Set WsO = Worksheets("Calcul")
jJ = CDate(Range("B1"))
R$ = ActiveWorkbook.Names("SDat").RefersTo
Y = CDate(Right(R, Len(R) - 1)) = jJ
If Not Y Then
On Error GoTo GESTERR
Workbooks.Open "récap.xls"
With Workbooks("récap.xls").Sheets("Recap_année")
ligmax = .Range("A65000").End(xlUp).Row + 1
.Range("A" & ligmax & ":A" & ligmax + 24) = jJ
WsO.Range("B3:L3,B10:L10,B11:L11").Copy
.Range("B" & ligmax).PasteSpecial Paste:=xlPasteValues, Transpose:=True
WsO.Range("I15:P15,I16:P16,I17:P17").Copy
.Range("B" & ligmax + 10).PasteSpecial Paste:=xlPasteValues, Transpose:=True
WsO.Range("I19:P19,I20:P20,I21:P21").Copy
.Range("B" & ligmax + 17).PasteSpecial Paste:=xlPasteValues, Transpose:=True
End With
Workbooks("récap.xls").Close True
Application.CutCopyMode = False
End If
ActiveWorkbook.Names.Add "SDat", CDate(Range("B1")), False
MsgBox ("Journée archivée.")
Application.ScreenUpdating = True
Exit Sub
GESTERR:
MsgBox "Une erreur imprévue vient de se produire !"
Application.ScreenUpdating = True
End Sub

Tu mets un petit coup de Sub Galopin() sur le classeur de travail pour déverouiller l'archivage avant de lancer la macro à partir de la feuille calcul.

A+

loloheureux
 Posté le 24/06/2008 à 09:34 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

bonjour Galopin,

tip top..le code fonctionne a merveille...

merci de ta patience et de ta participation...

en cadeau je t'offre les croissants, si est pas trop tard...

http://www.bellbe.com/bread/images/croissant.jpg" border="0" width="132" height="99" />

bonne journée

a bientôt

amicalement

laurent



Modifié par loloheureux le 24/06/2008 09:36
Publicité
galopin01
 Posté le 24/06/2008 à 16:15 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Astucien

bonjour,

Cette macro est quand même minimaliste : Toute la gestion des erreurs potentielles à été éludée.

Cela peut poser problème en particulier :

- si la récap est déjà ouverte, ou...
- si l'un ou l'autre des classeurs n'est pas dans le répertoire par défaut d'Excel, ou...
- si le classeur récap change de nom ou...
- si la feuille récap change de nom...

A+

Page : [1] 
Page 1 sur 1

Vous devez être connecté pour poster des messages. Cliquez ici pour vous identifier.

Vous n'avez pas de compte ? Créez-en un gratuitement !


Les bons plans du moment PC Astuces

Tous les Bons Plans
53,99 €Routeur Mobile TP-Link M7350 (4G LTE, Wifi 2,4GHz ou 5GHz) à 53,99 €
Valable jusqu'au 25 Octobre

Amazon fait une vente flash sur routeur Mobile TP-Link M7350 qui passe à 53,99 € livré gratuitement alors qu'on le trouve ailleurs à partir de 80 €.  Intégrant un modem 4G LTE, vous pouvez générer instanément un Hotspot Wi-Fi en insérant une carte SIM liée à un abonnement 4G dans l'appareil. Avec jusqu'à 150Mbps en téléchargement et 50Mbps en téléversement, le M7350 est capable de partager un signal 4G Wifi à près de 15 utilisateurs simultanément. Son format de poche et sa puissante batterie de 2000 mAh le rendent idéal comme compagnon de voyage, permettant aux utilisateurs de jouer ou travailler des heures.


> Voir l'offre
314,81 €Mini PC MINISFORUM UM300 (Ryzen 3 3300U, 16Go RAM, 512 Go SSD) à 314,81 € avec le code BGSEDK
Valable jusqu'au 25 Octobre

Banggood propose actuellement le mini PC MINISFORUM UM300 à 306,63 € avec le code promo BGSEDK. Ce mini PC au format NUC d'Intel possède un processeur Ryzen 3 3300U avec chip graphique Vega 6, 16 Go de RAM DDR4 et un SSD de 512 Go. Il dispose d'une connectique complète : un emplacement 2,5 pouces libre (pour ajouter un disque dur ou un SSD supplémentaire, le WiFi6, le bluetooth 5.1, 3 ports USB 3.1, un port HDMI 2.0, un DisplayPort, deux ports Ethernet Gigabit et tourne sous Windows 10 que vous pourrez mettre en français. Il est livré avec une alimentation européenne. Branchez ce mini PC sur une TV ou un écran et vous avez un ordinateur discret et performant. Comptez 8,18 € pour l'assurance et la livraison soit un total de 314,81 € livré.

Ce marchand sérieux se trouvant en Chine, la livraison peut prendre une vingtaine de jours. Vous pouvez payer par carte bancaire ou par Paypal (conseillé pour bénéficier de la garantie Paypal).


> Voir l'offre
90,74 €SSD Crucial P1 1 To (3D NAND, NVMe, PCIe, M.2) à 90,74 € livré (via coupon)
Valable jusqu'au 25 Octobre

Amazon Allemagne fait une promotion sur le SSD Crucial P1 1 To (3D NAND, NVMe, PCIe, M.2) qui passe à 86,20 € (avec la TVA ajustée) grâce à un coupon de réduction appliqué automatiquement au moment du paiement. Comptez 4,54 € pour la livraison en France soit un total de 90,74 € livré. On le trouve ailleurs à partir de 130 €. Ce SSD offre des vitesses de lecture/écriture séquentielle allant jusqu’à 2 000/1 750 Mo/s. Il est garanti 5 ans.

Vous pouvez utiliser votre compte Amazon France sur Amazon Allemagne et il n'y a pas de douanes. Si vous êtes perdu en allemand, vous pouvez traduire le site en anglais.


> Voir l'offre

Sujets relatifs
Excel 2007 Copier/Coller d’une feuille à l’autre Dans un même classeur.
Garder la forme d'un texte répété dans une autre feuille
Coller une image dans une autre feuille en VBA
Déplacer une feuille dans un autre classeur
activation feuille = écriture dans autre feuille
Copier 1 feuille xls dans un autre fichier
regrouper feuilles dans une feuille
2 pages par feuille dans macro excel
Recopie cellule dans un autre classeur
Copier plage de celules vers autre feuille sous condition
Plus de sujets relatifs à Feuille récap dans un autre répertoire!!!
 > Tous les forums > Forum Bureautique