Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Par macro, reporter en Feuil "BD" et aux bons endroits, en fonction d'une valeur

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Webperegrino

XLDnaute Accro
Supporter XLD
Bonjour Le Forum,

Je suis à la recherche d'une macro la plus courte et efficace par sa rapidité pour ceci :
- pouvoir, en fonction de la date choisie en D3 dans Feuil "SAISIE"
- Reporter le pavé B6:E12 aux bons endroits de Feuil "BD"
- puis vider le pavé B6:E12 de la Feuille "SAISIE" en attente d'une nouvelle saisie.

J'ai pour cela prévu dans l'essai de fichier ci-joint, un CommandButton "Reporter dans la Base".

Merci pour l'aide que vous pourriez m'apporter
Bonne journée à tous,
Webperegrino
 

Pièces jointes

Re : Par macro, reporter en Feuil "BD" et aux bons endroits, en fonction d'une valeur

Bonjour Webperegrino,

Complète ta macro comme ceci :

Code:
Private Sub REPORT_Click()
With Sheets("BD")
  For Each cel In .Range("3:3")
    If cel = Sheets("SAISIE").Range("D3") Then
      Col = cel.Column - 2
        For l = 6 To 12
          For c = 0 To 4
            .Cells(l, Col + c) = Sheets("SAISIE").Cells(l, c + 2)
          Next
        Next
      Exit Sub
    End If
  Next
End With
End Sub

Bonne journée.

Cordialement.
 
Re : Par macro, reporter en Feuil "BD" et aux bons endroits, en fonction d'une valeur

Bonjour à tous
Une autre proposition :
Code:
[COLOR="DarkSlateGray"][B]Private Sub REPORT_Click()
Dim obj
   With Sheets("SAISIE")
      Set obj = Sheets("Paramètres").Range("Date").Find(What:=.[D3].Value)
      If Not obj Is Nothing Then
         With .Range("B6:E12")
            .Copy Destination:=Sheets("BD").[A6].Offset(0, obj.Row * 5 - 4)
            .ClearContents
         End With
      End If
   End With
End Sub[/B][/COLOR]
ROGER2327
#3991


Vendredi 20 Tatane 137 (Saint Tiberge, frère quêteur, SQ)
15 Thermidor An CCXVIII
2010-W31-1T07:50:43Z
 
Dernière édition:
Re : Par macro, reporter en Feuil "BD" et aux bons endroits, en fonction d'une valeur

Le FORUM,
Bonjour Papou-Net,
Bonjour Roger 2327,

Grand merci à vous pour les deux propositions.
Dans un premier temps, la proposition de ROGER2327 me convient car vidange après validation. La classe !

Dans un deuxième temps, je vais essayer de compléter la proposition de Papou-net, pour savoir quelle macro sera la plus rapide.

Au fait, par simple curiosité, si quelqu'un sur ce parfait Forum connaît un procédé pour calculer le temps d'exécution d'une macro - avec affichage du résultat dans une cellule par exemple -, je suis preneur de l'astuce.

En tout cas merci, cela fonctionne déjà très bien maintenant.
Excellente journnée à vous
Webperegrino
 
Re : Par macro, reporter en Feuil "BD" et aux bons endroits, en fonction d'une valeur

Re...
Nos deux propositions ne font pas la même chose : celle de Papou-net copie les valeurs de la plage B6:F12 tandis que la mienne copie la plage B6:E12. S'il s'agit bien de copier les valeurs de B6:F12, je propose l'adaptation suivante de ma première proposition :
Code:
[COLOR="DarkSlateGray"][B]Private Sub REPORT_Click()
[COLOR="DarkOrange"]Dim t As Single
t = Timer[/COLOR]

Dim obj
   With Sheets("SAISIE")
      Set obj = Sheets("Paramètres").Range("Date").Find(What:=.[D3].Value)
      If Not obj Is Nothing Then
         With .[B6]
            Sheets("BD").[A6].Offset(0, obj.Row * 5 - 4).Resize(7, 5).Value = .Resize(7, 5).Value
            .Resize(7, 4).ClearContents
         End With
      End If
   End With

[COLOR="DarkOrange"]t = Timer - t
REPORT.Caption = "Reporter dans la Base" & vbLf & Round(t, 3) & " s"[/COLOR]
End Sub[/B][/COLOR]
Le code écrit en orange permet d'afficher la durée d'exécution dans le bouton.​
ROGER2327
#3993


Vendredi 20 Tatane 137 (Saint Tiberge, frère quêteur, SQ)
15 Thermidor An CCXVIII
2010-W31-1T14:04:59Z
 
Re : Par macro, reporter en Feuil "BD" et aux bons endroits, en fonction d'une valeur

Bonsoir Webperegrino, ROGER2327,

Au temps pour moi, j'ai oublié la seconde demande de Webperegrino, qui désirait effacer les données de la feuille SAISIE.

Voilà qui est réparé (ligne en rouge).

Code:
Private Sub REPORT_Click()
With Sheets("BD")
  For Each cel In .Range("3:3")
    If cel = Sheets("SAISIE").Range("D3") Then
      Col = cel.Column - 2
        For l = 6 To 12
          For c = 0 To 4
            .Cells(l, Col + c) = Sheets("SAISIE").Cells(l, c + 2)
          Next
        Next
      [COLOR="Red"][B]Sheets("SAISIE").Range("B6:F12").ClearContents[/B][/COLOR]
      Exit Sub
    End If
  Next
End With
End Sub

Par contre, je n'ai pas compris la réponse de Roger, et je ne vois pas le pourquoi de la recherche de la date sur la feuille Paramètres. J'ai testé, la copie ne se fait pas sur la feuille BD.

Par ailleurs, la durée de ma macro se situe aux alentours de 0,003/0,009 s.

Cordialement.
 
Re : Par macro, reporter en Feuil "BD" et aux bons endroits, en fonction d'une valeur

Le Forum, ROGER2327, Papou-Net,
Bonsoir,
Vos corrections et raisonnements me comblent.
J'ai maintenant le choix.

ROGER2327, j'apporte la correction suivante : .Resize(7, 5).ClearContents
(le tableau se vide entièrement, c'est aisni mieux)
Le calcul du temps : j'ai compris qu'on peux mettre une décimale de plus avec Round(t, 4)

Enfin si j'ai 49 lignes dans mon tableau je mettrai donc .Resize(49, 5).Value
(49 lignes, 5 colonnes)

Il me reste à comprendre :
1) .Offset(0, obj.Row * 5 - 4)
3) le raisonnement des deux dernières propositions de Papou et de Roger, excellentes
2) les appliquer dans mon fichier de travail

Merci à vous, j'ai encore appris
Bonne soirée
Webperegrino
 
Re : Par macro, reporter en Feuil "BD" et aux bons endroits, en fonction d'une valeur

Re...
(...) j'apporte la correction suivante : .Resize(7, 5).ClearContents
(le tableau se vide entièrement, c'est aisni mieux) (...)
Ce faisant vous perdez la formule de calcul dans la dernière colonne. Mais c'est vous qui voyez...

Si la zone à "vider" est exactement de même taille que la zone à copier, le code peut se simplifier ainsi :
Code:
[COLOR="DarkSlateGray"][B]Private Sub REPORT_Click()
Dim t As Single
t = Timer

Dim obj, plgAdresse$
   With Sheets("SAISIE")
      Set obj = Sheets("Paramètres").Range("Date").Find(What:=.[D3].Value)
      If Not obj Is Nothing Then
         plgAdresse = "B6:F12" [COLOR="SeaGreen"]'Plage à adapter selon le besoin.[/COLOR]
         With .Range(plgAdresse)
            Sheets("BD").Range(plgAdresse).Offset(0, obj.Row * 5 - 5).Value = .Value
            .ClearContents
         End With
      End If
   End With

t = Timer - t
REPORT.Caption = "Reporter dans la Base" & vbLf & Round(t, 3) & " s"
End Sub[/B][/COLOR]

(...) Il me reste à comprendre :
1) .Offset(0, obj.Row * 5 - 4) (...)
Dans le code, obj est la cellule contenant la date sélectionnée dans la feuille Paramètres correspondant à la date choisie dans la feuille SAISIE. En fonction de la ligne obj.Row, Offset(0, obj.Row * 5 - 4) calcule le décalage à effectuer à partir de la cellule de référence Sheets("BD").[A6] pour placer les données dans la bonne plage.

Pour ce qui est de la remarque de Papou-net :
(...) je ne vois pas le pourquoi de la recherche de la date sur la feuille Paramètres (...)
je pense que puisque les dates utilisées dans les autres feuilles proviennent de cette liste, il est assez logique d'aller les y chercher chaque fois qu'il le faut. Mais ce n'est évidemment pas une obligation : on peut aller les chercher ailleurs comme vous le faites dans votre proposition.
Enfin :
(...) J'ai testé, la copie ne se fait pas sur la feuille BD. (...)
Je veux bien vous croire, puisque vous le dites. Mais c'est la faute à pas de chance : j'ai, comme toujours, testé ce que je propose, et je ne l'ai proposé que parce que le test m'a semblé concluant. Comme un problème auquel je n'ai pas songé est toujours possible, pourriez-vous déposer le classeur qui ne fonctionne pas sur le forum, afin que nous trouvions l'origine du problème ? Merci d'avance.​
ROGER2327
#3996


Samedi 21 Tatane 137 (Saints Catoblepas, lord et Anoblepas, amirals, SQ)
16 Thermidor An CCXVIII
2010-W31-2T00:28:55Z
 
Dernière édition:
Re : Par macro, reporter en Feuil "BD" et aux bons endroits, en fonction d'une valeur

Le Forum, Roger2327 et Papou-net,
Bonsoir-bonjour plutôt,

Roger, vous aviez raison.
J'ai essayé vérifié et suis revenu sur vos recommandations précédentes.
Vous avez donc raions pour << .Resize(7, 4).ClearContents >> car avec 5 ...

<< Ce faisant vous perdez la formule de calcul dans la dernière colonne >>>.
C'est compris, merci pour votre pédagogie.

J'étudie calmement vos explications qui suivent dans le dernier message.
Merci pour le sérieux de cette formation bien utile.

Webperegrino
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…