Copier dans une autre feuille une plage de cellule contenant des heures

Bonjour,

J'ai un problème avec une macro que j'ai mis en place. Mon objectif serait de sélectionner dans la feuille "feuille_support" les cellules de la colonne D comprit entre 7H et 12H pour que cette plage horaire soit copier dans une autre feuille de ce même classeur "Alerte J+2 et J+3".

Malheureusement j'ai un message d'erreur "1004 : erreur définie par l'application ou par l'objet".

Je vous transmets mon code ci-contre.

Merci d'avance pour votre aide !

Sub RDV()

Worksheets("Alertes J+2 et J+3").Range("F6:F20").Value = Worksheets("feuille_support").Range("01/01/1970 07:00:00: 01/01/1970 12:00:00").Value

End Sub

Bonjour Raph_osorio, le forum,

Un fichier (sans données confidentielles) peut -être ?

Cordialement,

Bonjour,

Oui bien sur pas de soucis.

Le code est dans le Module 7 du VBAProject ( EXTRA_FINALOct.xlsm )

Merci pour votre aide.

Re,

Merci pour le fichier,

Je ne comprends pas ce qu'il faut extraire, donc voici un exemple d'extraction de la colonne D correspondant aux 2 critères.

Les données sont recopiées sur la feuille test.

Sub RDV()
 Dim tb, Newtb(), i&, k&

 Application.ScreenUpdating = False

  With Sheets("feuille_support")
   tb = .Range("A1").CurrentRegion
   k = 0
   ReDim Newtb(0 To UBound(tb, 1), 1 To 1)
   For i = 1 To UBound(tb, 1)
     If Format(tb(i, 4), "hh:mm:ss") >= "07:00:00" And Format(tb(i, 4), "hh:mm:ss") <= "12:00:00" Then
       Newtb(k, 1) = tb(i, 4)
       k = k + 1
     End If
   Next i
  End With

  If k > 0 Then
    With Sheets("test")
    On Error Resume Next
     .Range("A1").CurrentRegion.Offset(1, 0).ClearContents
     .Range("A1") = "RDV": .Range("A1").Font.Bold = True
     .Range("A2").Resize(k, 1).Value = Newtb
     .Columns(1).NumberFormat = "h:mm;@"
     .Activate
    End With
  End If
 Erase tb: Erase Newtb
End Sub

Cordialement,

Bonjour

Je ne comprends pas cette référence

Range("01/01/1970 07:00:00: 01/01/1970 12:00:00")

Cordialement

FINDRH

Merci pour ton code.

J'aimerais extraire les données de la colonne "RDV" comprit entre 7h et 12h vers la feuille "Alertes J+2 et J+3" plus précisément en ("F6")

L'objectif serait de relier les dates avec cette plage de cellule :

Exemple : 19/12/2022 -> 08:00:00 ( dans la feuille "Alertes J+2 et J+3" )

J'espère que vous m'avez compris, sinon j'expliquerais autrement !

Bonjour,

Pour vous répondre FINDRH, cela représente la plage horaire que j'aimerais sélectionner.

Donc qui est comprit entre 7h et 12h.

Cordialement,

Re,

J'aimerais extraire les données de la colonne "RDV" comprit entre 7h et 12h vers la feuille "Alertes J+2 et J+3" plus précisément en ("F6")

Sub RDV()
 Dim tb, Newtb(), i&, k&

 Application.ScreenUpdating = False

  With Sheets("feuille_support")
   tb = .Range("A1").CurrentRegion
   k = 0
   ReDim Newtb(0 To UBound(tb, 1), 1 To 1)
   For i = 1 To UBound(tb, 1)
     If Format(tb(i, 4), "hh:mm:ss") >= "07:00:00" And Format(tb(i, 4), "hh:mm:ss") <= "12:00:00" Then
       Newtb(k, 1) = tb(i, 4)
       k = k + 1
     End If
   Next i
  End With

  If k > 0 Then
    With Sheets("Alertes J+2 et J+3")
    On Error Resume Next
     .Range("F6").Resize(k, 1).Value = Newtb
     .Columns(6).NumberFormat = "h:mm;@"
     .Activate
    End With
  End If
 Erase tb: Erase Newtb
End Sub

Pour le reste, je n'ai rien compris,

Cordialement,

Merci beaucoup pour votre code qui fonctionne parfaitement !

Alors je réexplique

Sachant que nous avons copier la plage de cellule comprise entre 7h et 12h, j'aimerais relier les différents horaires en fonction des dates.

Chaque horaire est relier a une date donc l'objectif ici serait d'obtenir les dates appartenant a la plage de cellule et de les copier dans la feuille "Alertes J+2 et J+3" et plus précisément en G6.

La colonne correspondant aux dates est dans la feuille "feuille_support", colonne B "Dateliv".

J'espère m'être fait comprendre !

Re,

Chaque horaire est relier a une date donc l'objectif ici serait d'obtenir les dates appartenant a la plage de cellule et de les copier dans la feuille "Alertes J+2 et J+3" et plus précisément en G6.

Sub RDV()
 Dim tb, Newtb(), i&, k&

 Application.ScreenUpdating = False

  With Sheets("feuille_support")
   tb = .Range("A1").CurrentRegion
   k = 0
   ReDim Newtb(0 To UBound(tb, 1), 1 To 2)
   For i = 1 To UBound(tb, 1)
     If Format(tb(i, 4), "hh:mm:ss") >= "07:00:00" And Format(tb(i, 4), "hh:mm:ss") <= "12:00:00" Then
       Newtb(k, 1) = tb(i, 4)
       Newtb(k, 2) = tb(i, 2)
       k = k + 1
     End If
   Next i
  End With

  If k > 0 Then
    With Sheets("Alertes J+2 et J+3")
    On Error Resume Next
     .Range("F6").Resize(k, 2).Value = Newtb
     .Columns(6).NumberFormat = "h:mm;@"
     .Activate
    End With
  End If
 Erase tb: Erase Newtb
End Sub

Cordialement,

Bonjour,

Merci beaucoup pour votre code qui est très utile.

J'ai une dernière demande : l'objectif serait d'avoir une fois de plus dans la feuille "Alertes J+2 et J+3" les départements ( "feuille_support" -> colonne E "DPT") en H5 et le nom des villes relier aux dates/heures de livraison ( "feuille_support" -> colonne F "VILLE" ) en I5.

Merci d'avance !

Bonjour Raph_osorio, le forum,

Tu aurais pu préciser dès le départ que tu souhaitais 4 colonnes, tu aurais gagné du temps,

Sub RDV()
 Dim tb, Newtb(), i&, k&
'désactive le rafraichissement de l'écran
 Application.ScreenUpdating = False
 'agit sur cette feuille uniquement
  With Sheets("feuille_support")
  'définit le tableau de valeur tb
   tb = .Range("A1").CurrentRegion
  'indice de ligne
   k = 0
 'redimensionne le tableau Newtb qui recevra les données souhaitées
' nombre de ligne de tb et 4 colonnes
   ReDim Newtb(0 To UBound(tb, 1), 1 To 4)
  'boucles sur toutes les lignes de tb
   For i = 1 To UBound(tb, 1)
   'si heure de la quatrième colonne comprise entre 7H et 12H
     If Format(tb(i, 4), "hh:mm:ss") >= "07:00:00" And Format(tb(i, 4), "hh:mm:ss") <= "12:00:00" Then
       Newtb(k, 1) = tb(i, 4) 'colonne 1 de Newtb = colonne 4 de tb (heures)
       Newtb(k, 2) = tb(i, 2) 'colonne 2 de Newtb = colonne 2 de tb (dates)
       Newtb(k, 3) = tb(i, 5) 'colonne 3 de Newtb = colonne 5 de tb (départements)
       Newtb(k, 4) = tb(i, 6) 'colonne 4 de Newtb = colonne 6 de tb (villes)
       k = k + 1 'incrémente l'indice k
     End If
   Next i
  End With

  If k > 0 Then
    With Sheets("Alertes J+2 et J+3")
    On Error Resume Next
    'efface les données existantes des colonnes F à I
     .Range("F6:I" & .Range("F" & Rows.Count).End(xlUp).Row).ClearContents
     'retranscrit les données de Newtb à partir de F6
     .Range("F6").Resize(k, 4).Value = Newtb
     'formate la colonne F
     .Columns(6).NumberFormat = "h:mm;@"
     'active la feuille
     .Activate
    End With
  End If
'efface tb et Newtb : libère la mémoire
 Erase tb: Erase Newtb
End Sub

PS: Attention, dans ton exemple tu n'as aucune ville d'inscrite....

Cordialement,

Merci beaucoup !

Oui c'est vrai j'aurais du le dire dès le début !

Excellente journée à toi !

Re,

Une petite variante..

Cordialement,

Merci beaucoup !

J'ai une nouvelle demande à te faire, c'est une demande qui a était faite par mon responsable.

Si tu es disponible fais moi signe !

Bonjour Raph_osorio,

J'ai une nouvelle demande à te faire, c'est une demande qui a était faite par mon responsable.

Si tu es disponible fais moi signe !

Le forum regorge de gens talentueux, si je ne suis pas dispo (où si c'est trop complexe pour moi), d'autres prendront le relai,

Cordialement,

Ca marche pas de soucis !

Alors j'ai de nouveau un code VBA a mettre en place.

Celui-ci est lié aux nombres de dates et aux heures de RDV. Juste avant j'ai créé deux tableaux rassemblant les dates et heures de RDV.

Le 1 er : rassemble les chargements de la veille pour livraison le matin (compris entre 5h et 12h30)
Le 2 ème : rassemble le nombre de chargements au matin pour les livraisons de l'après-midi (après 13h...)

On a un tableau placer au dessus des chargements de la veille.

La colonne "Dateliv" dans le tableau croisé dynamique représente les dates de livraison. J'aimerai me référer par rapport a ces dates là.

L'objectif ici serait de compter le nombre de chargements la veille par date et de les copier dans le tableau du dessus.

Exemple

Je voudrais compter le nombre de fois que la date "03/01/2023" est indiqué dans le tableau de chargement la veille pour livraison au matin et faire afficher le résultat dans la colonne référente au 03/01/2023 en F6 ( nb chg livraison matin )

Et faire la même chose pour les chargement au matin pour les livraisons de l'après-midi.

J'ai tout de même essayé de mettre en place un code VBA mais ce dernier ne calculait seulement la cellule B6 ( 03/01/2023 ) ce qui me donnait un total de 1.

J'espère que tu m'a compris !

Merci d'avance pour ton aide et je te souhaite de très bonnes fêtes !

Je te transmets le fichier dès que je peux !

Bonsoir,

Effectivement, avec le fichier ce sera sans doute plus parlant, parce que là, je n'ai rien compris,

A bientôt,

Bonjour,

Bonne année mes meilleurs vœux !

J'ai trouvé une solution pour ma dernière demande, mais aujourd'hui j'ai un problème sur l'importation des données des heures du matin.

J'avais bien repris votre code VBA tout fonctionnait bien et depuis hier une valeur #N/A apparaît lorsque j'ouvre le fichier ( donc dès la macro se lance )

Voulez-vous avoir mon fichier ? C'est le même que je vous ai transmis il y à a peu près 1 mois.

Merci beaucoup pour votre aide !!!

Voici ci contre mon code VBA :

Sub Heures_Matin_Ambes_Predalles()
Dim tb, Newtb(), i&, k&
'désactive le rafraichissement de l'écran
Application.ScreenUpdating = False
'agit sur cette feuille uniquement
With Sheets("feuille_support")
'définit le tableau de valeur tb
tb = .Range("A1").CurrentRegion
'indice de ligne
k = 0
'redimensionne le tableau Newtb qui recevra les données souhaitées
' nombre de ligne de tb et 4 colonnes
ReDim Newtb(0 To UBound(tb, 1), 1 To 7)
'boucles sur toutes les lignes de tb
For i = 1 To UBound(tb, 1)
'si heure de la quatrième colonne comprise entre 7H et 12H
If Format(tb(i, 4), "hh:mm:ss") >= "05:00:00" And Format(tb(i, 4), "hh:mm:ss") <= "12:30:00" Then
Newtb(k, 1) = tb(i, 2) 'colonne 1 de Newtb = colonne 2 de tb (dates)
Newtb(k, 2) = tb(i, 4) 'colonne 2 de Newtb = colonne 4 de tb (heures)
Newtb(k, 3) = tb(i, 5) 'colonne 3 de Newtb = colonne 5 de tb (départements)
Newtb(k, 4) = tb(i, 6) 'colonne 4 de Newtb = colonne 6 de tb (villes)
Newtb(k, 5) = tb(i, 7) 'colonne 5 de Newtb = colonne 7 de tb (designation)
Newtb(k, 6) = tb(i, 3) 'colonne 6 de Newtb = colonne 3 de tb (conf)

k = k + 1 'incrémente l'indice k
End If
Next i
End With

If k > 0 Then
With Sheets("Alertes J+2 et J+3")
On Error Resume Next
'efface les données existantes des colonnes B à G
.Range("B15:G" & .Range("B" & Rows.Count).End(xlUp).Row).ClearContents
'retranscrit les données de Newtb à partir de F6
.Range("B15").Resize(k, 7).Value = Newtb
'formate la colonne F
.Columns(2).NumberFormat = "dd/mm/yyyy"
'active la feuille
.Activate
End With
End If
'efface tb et Newtb : libère la mémoire
Erase tb: Erase Newtb
End Sub