Prendre date de deux colonnes d'un onglet et les remettre dans un autre

Bonjour

J'ai dans une feuille excel (disons "general") des dates qui sont mises à jour continuellement , dans deux colonnes : date départ dans colonne F et date retour dans colonne G.

Dans une autre feuille (disons "daily"), l'idée est que chaque colonne reçoive une date, issue des dates existantes dans les colonnes F+G de l'onglet "general". Chaque date, à partir de la cellule A6 sur toute la ligne 6, sera mise d'après un ordre chronologique, c'est à dire si en A6 j'ai 13/2/19 alors en B6 j'aurai 14/2/19, en C6 j'aurai 15/2/19 etc sauf si une date n'existe pas dans les 2 colonnes F et G de l'autre onglet. Dans ce cas la prochaine colonne de la ligne 6 recevra la prochaine date selon ordre chronologique.

A6 par exemple recevra toujours la plus petite de toutes les dates trouvées dans les colonne F+G de l'autre onglet, B6 recevra la date la plus petite la suivante après celle de A6 et ainsi de suite.

Par exemple: si dans les colonnes F et G de l'onglet "general" j'ai des dates comme 13/2/19, 15/2/19, 17/2/19, 14/2/19, 21/2/19, 1/3/19

alors l'onglet "daily" apparaitra comme cela:

en A6 il y aura la date 13/2/19

en B6 14/2/19

en C6 15/2/19

en D6 17/2/16

en E6 21/2/19

en F6 1/3/19

etc...

Quelqu'un connaitrai-il une macro qui puisse "prélever" toutes les dates des colonnes F et G d'un onglet et les réintégrer dans les cellules de la ligne 6, colonne après colonne, en les mettant selon leur ordre chronologique?

(macro qui soit automatique dès qu'on change une date dans l'une des deux colonnes (F/G) de l'onglet "general" )

J'espère que c'est possible...

Merci d'avance pour ceux qui pourront m'éclairer sur la question

Bonjour,

Oui c'est faisable comme macro, ça se code, mais sans fichier, on ne peut pas coder!

Aux explications, pense à joindre un fichier, ça sert bien mieux à suivre ce que tu racontes! Parce que je doute que quelqu'un te sorte un lien qui répondra directement à ton cas En revanche on a des programmateurs qui se débrouillent et qui pourront t'aider parmis les membres du forum.

Reviens vers nous avec un fichier (Excel)

Entierement raison!

Voyez l'onglet "general" et "daily"

Merci!!

3rooming-list.xlsm (256.93 Ko)

Rebonjour,

Même avec les explications et le fichier, je ne comprends pas comment ça marche, surtout que je n'ai pas l'impression que les données exemples dans l'onglet general et daily matchent, pourrais-tu me fournir un exemple qui fonctionne avec des explications qui suivent tes valeurs?

Là ça me perd plus qu'autre chose

ci-joint

j'espere que cela sera plus clair comme cela...

J'ai mis dans les colonnes F et G d'autres dates

1rooming-list.xlsm (258.53 Ko)

La macro suivante pose un début de réponse à mon problème.

Je l'ai essayé comme macro simple (private sub) et elle fonctionne: elle extrait toutes les dates contenues entre 2 dates extrêmes, l'une à la suite de l'autre sur la même ligne (6), colonne après colonne.

Mais quand je veux qu'elle s'exécute automatiquement à chaque fois qu'on change des dates dans l'onglet "general", elle bug:

select method of range class failed

et ça montre en jaune la ligne:

Sheets("daily").Range("A6").Select

De plus, je souhaiterais effacer le contenu des cellules de toute la ligne 6 de l'onglet "daily" à chaque fois que la macro s'exécute afin que toujours les dates s'inscrivent dans une ligne vide de valeurs. J'ai rajouté la ligne Sheets("daily").Range("A6:FF6").ClearContents qui ne fonctionne pas dans la macro

Voici le code...

Private Sub Worksheet_Change(ByVal Target As Range)

Dim DateDebut As Date

Dim DateFin As Date

Sheets("daily").Range("A6:FF6").ClearContents

DateDebut = Sheets("general").Range("R1").Value

DateFin = Sheets("general").Range("S1").Value

Sheets("daily").Range("A6").Select

Do While DateDebut <= DateFin

ActiveCell.Value = DateDebut

ActiveCell.Offset(0, 1).Select

DateDebut = DateAdd("d", 1, DateDebut)

Loop

end sub

3rooming-list.xlsm (257.72 Ko)

Bonjour

Ah, une macro que je peux tester! Super

Donc je viens de tester, en effet ça plante... Et j'ai une idée du pourquoi, déjà pour supprimer le contenu de la ligne 6, j'ai utilisé la propriété entirerow de Range("A6") :

Range("A6").entirerow.clearcontents

Pour ton soucis de select je pense avoir une idée aussi, normalement, une ligne comme celle là fonctionnerait parfaitement dans un module, mais là tu es dans une procédure évènementielle, d'une feuille précise, qui essaye de sélectionner la cellule d'une autre feuille, et là... ça plante. Je ne saurais pas expliquer exactement pourquoi, je me passe tout le temps de la ligne select quand je code, je préfère de loin utiliser l'instruction With qui ne pose aucun problème.

Je te joins le fichier avec le programme qui marche

5rooming-list.xlsm (253.92 Ko)

J'ai vu la macro merci !!:)

Mais si j'écris par exemple les dates 1/5 au 6/5 et ensuite j'écris 10/5-12/5 ça inscrit aussi les dates 7/5, 8/5 et 9/5 mais celles ci ne sont pas dans les dates des rangées donc ne doivent pas être copiées vers DAILY.

Problème ressemblant dans le cas où je rajoute dans le tableau General des dates antérieures à celles déjà copiées vers Daily.

Par exemple si j'ai déjà 1/5 au 9/5 et je rajoute 1/4-3/4, ça me copie non seulement les dates entre 1/4 au 3/4 mais aussi toutes les dates entre 4/4 et 30/4!

'Export dates

Dim DateDebut As Date

Dim DateFin As Date

Sheets("daily").Range("A6").EntireRow.ClearContents

DateDebut = Sheets("general").Range("R1").Value

DateFin = Sheets("general").Range("S1").Value

With Sheets("daily")

col = 1

Do While DateDebut <= DateFin

.Cells(6, col) = DateDebut

col = col + 1

DateDebut = DateAdd("d", 1, DateDebut)

Loop

End With

Bonjour,

Dommage que cette partie là ne marche pas, parce que j'étais réticent à l'idée de me pencher sur cette partie du programme

Pourquoi? Parce que je ne comprends pas la logique derrière...

Je pense qu'il faudrait que tu changes ta façon d'exporter les dates, que tu tries tes lignes par date de début, puis que tu exportes petit à petit avec une boucle, et que tu n'exportes pas la valeur si elle est déjà présente dans la feuille (avec un find par exemple). Sinon tu ne t'en sortiras pas, puisqu'il faut que ça sorte dans l'ordre, tu penses pouvoir essayer de commencer à bricoler quelque chose qui va dans ce sens?

Malheureusement je ne suis pas du tout bon en programmation. Je ne sais qu'adapter un peu les codes mais pas les créer depuis le début

J'explique la logique de la macro, qui n'est qu'une partie en fait. Car je cherche également après avoir mis les dates, à écrire les noms au dessous de chacune.

J'explique:

Dans l'onglet General, j'ai une liste de noms de clients, disons, avec les dates de leur séjour à l'hôtel. Par exemple Lionel du 1/5 au 5/5 et Julien du 7/5 au 9/5

L'onglet Daily montre en fait les mêmes informations mais classées par journée. Il montre chaque jour (seulement les jours qui sont inscrits dans l'intervalle de dates de l'autre onglet) les noms des clients par jour, car l'hôtel parfois demande à savoir chaque jour qui sont ses clients pour savoir combien de chambres il peut donner chaque jour.

Donc pour reprendre l'exemple précédent, Lionel sera inscrit dans la colonne sous la date 1/5, et sous la date 2/5, sous 3/5, sous 4/5 et sous 5/5

Mais le 6/5 , n'existant pas dans aucun intervalle de dates, cette date n'existera pas dans l'onglet Daily et n'apparaitra pas à la tête d'une colonne en ligne6

Et la prochaine colonne après le 5/5 aura comme date le 7/5, sous laquelle Julien sera inscrit, puis 8/5 et 9/5 avec Julien.

J'ai trouvé une macro qui pourrait fonctionner mais elle ne l'est pas. Elle serait la continuation de la macro qui copie les dates, car après avoir copier les dates comme il le faut, elle devrait appeler (Call) la macro names2

D'ABORD ON EXPORTE LES DATES VERS DAILY: (macro dans code de l'onglet General)

'Export dates

Dim DateDebut As Date

Dim DateFin As Date

Sheets("daily").Range("A6").EntireRow.ClearContents

Sheets("daily").Range("A10:FF200").Clear

DateDebut = Sheets("general").Range("R1").Value

DateFin = Sheets("general").Range("S1").Value

With Sheets("daily")

col = 1

Do While DateDebut <= DateFin

.Cells(6, col) = DateDebut

col = col + 1

DateDebut = DateAdd("d", 1, DateDebut)

Loop

End With

Call names2

End Sub

PUIS ELLE APPELLE LA MACRO QUI TRANSFERE LES NOMS VERS DAILY (macro placée dans un module):

Sub names2()

Application.ScreenUpdating = False

Set h1 = Sheets("general")

Set h2 = Sheets("daily")

'take each name in each row in sheet "general"

For i = 3 To h1.Range("B" & Rows.Count).End(xlUp).Row

w_name = h1.Cells(i, "B").Value

fec1 = h1.Cells(i, "F").Value

fec2 = h1.Cells(i, "G").Value

For j = fec1 To fec2

Set b = h2.Rows(6).Find(j, lookat:=xlWhole, LookIn:=xlValues)

If Not b Is Nothing Then

u2 = h2.Cells(Rows.Count, b.Column).End(xlUp).Row + 1

If u2 < 10 Then u2 = 10

h2.Cells(u2, b.Column).Value = w_name

End If

Next

Next

Application.ScreenUpdating = True

h2.Select

MsgBox "just to see if macro works. if no names appear=does not work"

End Sub

Voila . C'est pourquoi je voulais que les dates ne prennent pas en compte celles qui ne sont pas comprises dans les intervalles du tableau.

Peut être est-ce possible de laisser comme cela mais de rajouter une ligne de code qui cache (hide) les colonnes qui ont une date mais aucun noms en dessous (à partir de la ligne 10 car s'il y a noms recopiés, ils ne le seront qu'à partir de la ligne 10 de l'onglet daily ) après que les noms aient été transférés là où il le faut ? Ca ne me permettrait pas de mettre de titres en haut de l'onglet car si des colonnes au début entre A et C viennent à être rendues invisibles le titre aussi disparaitra, mais c'est un soucis moindre avec lequel je pourrais m'arranger.

Je joins le fichier

5rooming-list.xlsm (259.14 Ko)

Bonjour,

J'ai créé un nouveau programme que j'ai mis dans un module pour le tester:

Sub test()
Dim WsSource As Worksheet, WsDest As Worksheet
Set WsSource = Sheets("general")
Set WsDest = Sheets("daily")

der_lig = WsSource.Range("a" & Rows.Count).End(xlUp).Row
tableau = WsSource.Range("a3", "n" & der_lig)
Dim tableauResultat
ReDim tableauResultat(1 To UBound(tableau, 1), 1 To 2)
Dim Min(1 To 1, 1 To 3)

'Tri du tableau par date de départ
For i = LBound(tableau, 1) To UBound(tableau, 1)
    tableauResultat(i, 1) = tableau(i, 6)
    tableauResultat(i, 2) = i
Next i

For i = LBound(tableauResultat, 1) To UBound(tableauResultat, 1)
    Min(1, 1) = tableauResultat(i, 1)
    Min(1, 2) = tableauResultat(i, 2)
    Min(1, 3) = i
    For h = i + 1 To UBound(tableauResultat, 1)
        If tableauResultat(h, 1) < Min(1, 1) Then
            Min(1, 1) = tableauResultat(h, 1)
            Min(1, 2) = tableauResultat(h, 2)
            Min(1, 3) = h
        End If
    Next h
    If Min(1, 3) <> i Then
        tableauResultat(Min(1, 3), 1) = tableauResultat(i, 1)
        tableauResultat(Min(1, 3), 2) = tableauResultat(i, 2)
        tableauResultat(i, 1) = Min(1, 1)
        tableauResultat(i, 2) = Min(1, 2)
    End If
Next i
'Tri terminé

'Début de l'export via des boucles
With WsDest
    .Range("a6", .Cells(Rows.Count, Columns.Count)).EntireRow.ClearContents
    nbcol = 0

    For i = LBound(tableauResultat, 1) To UBound(tableauResultat, 1)
        ligtab = tableauResultat(i, 2)
        If tableau(ligtab, 6) <> "" And tableau(ligtab, 7) <> "" Then
            For j = tableau(ligtab, 6) To tableau(ligtab, 7) - 1
                If .Range("a6").EntireRow.Find(j) Is Nothing Then
                    .Cells(6, nbcol + 1) = j
                    .Cells(7, nbcol + 1) = tableau(ligtab, 2)
                    nbcol = nbcol + 1
                Else
                    col = .Range("a6").EntireRow.Find(j).Column
                    ligne = .Cells(Rows.Count, col).End(xlUp).Row + 1
                    .Cells(ligne, col) = tableau(ligtab, 2)
                End If
            Next j
        End If
    Next i
End With
End Sub

ça permet de trier dans l'ordre chronologique les dates, et ça exporte les données :date, personne, si les dates de début et de fin sont renseignées, si j'ai bien compris, du 2 au 5 mai veut dire que la chambre est prise les 2,3,4 mai, et que la personne part le 5 mai au matin, comme tu comptes ça comme étant 3 nuits seulement, du coup tu n'auras que les 2,3,4 mai qui apparaitront pour une date de ce type.

Je te laisse tester et me dire.

4rooming-list.xlsm (261.27 Ko)

Les anges existent!

Tu en est un!!!!

Tu ne sais pas à quel point tu m'as aidé là!!! Un GRAND MERCI pour tout! Vraiment!

Je ne sais pas si je suis un ange, mais merci du compliment en tout cas

De rien pour le coup de main

Bon courage pour la suite, on se reverra peut-être

C'est certain

Bonjour Ausecour

Ta macro a parfaitement fonctionné pendant un certain temps.

Mais tout d'un coup elle ne fonctionne plus.

La seule différence: j'ai ajouté plusieurs "couples" d'onglets "general" et "daily" que j'ai différenciés avec un chiffre (general2, general 3... daily2, daily3, ...) et j'ai bien sur corrigé dans la macro le nom de l'onglet daily en conséquence.

De plus j'ai placé cette macro en tant que macro "normale" c'est à dire qu'elle ne s'active plus automatiquement dès qu'on écrit un nom (colonne B) et deux dates (colonnes F et G).

J'ai aussi essayé en remplaçant de nouveau

 Set WsSource = ActiveSheet 

par

Set WsSource = sheets("general")

comme tu l'avais écrit à l'origine, sans succès...

Elle aurait du fonctionner, mais non! Elle se bloque et Excel se met en mode "Not responding"- je dois forcer l'arrêt d'Excel pour le fermer...

J'ai vérifié et Excel se bloque à cause de cette macro, et non à cause d'une autre.

J'ai placé la macro dans un module et aussi dans le code de l'onglet "general", mais dans les deux cas Excel bloque lorsque je lance cette macro

Pourrais-tu m'aider STP?

Je joins le fichier.

  Sub transfer()

'copy dates and names to daily

Dim WsSource As Worksheet, WsDest As Worksheet
Set WsSource = ActiveSheet
Set WsDest = Sheets("daily")

der_lig = WsSource.Range("a" & Rows.Count).End(xlUp).Row
tableau = WsSource.Range("a3", "n" & der_lig)
Dim tableauResultat
ReDim tableauResultat(1 To UBound(tableau, 1), 1 To 2)
Dim Min(1 To 1, 1 To 3)

'Tri du tableau par date de départ
For i = LBound(tableau, 1) To UBound(tableau, 1)
    tableauResultat(i, 1) = tableau(i, 6)
    tableauResultat(i, 2) = i
Next i

For i = LBound(tableauResultat, 1) To UBound(tableauResultat, 1)
    Min(1, 1) = tableauResultat(i, 1)
    Min(1, 2) = tableauResultat(i, 2)
    Min(1, 3) = i
    For h = i + 1 To UBound(tableauResultat, 1)
        If tableauResultat(h, 1) < Min(1, 1) Then
            Min(1, 1) = tableauResultat(h, 1)
            Min(1, 2) = tableauResultat(h, 2)
            Min(1, 3) = h
        End If
    Next h
    If Min(1, 3) <> i Then
        tableauResultat(Min(1, 3), 1) = tableauResultat(i, 1)
        tableauResultat(Min(1, 3), 2) = tableauResultat(i, 2)
        tableauResultat(i, 1) = Min(1, 1)
        tableauResultat(i, 2) = Min(1, 2)
    End If
Next i
'Tri terminé

'Début de l'export via des boucles
With WsDest

    .Range("a6", .Cells(Rows.Count, Columns.Count)).EntireRow.ClearContents
    .Range("a3", .Cells(Rows.Count, Columns.Count)).EntireRow.ClearContents

    nbcol = 0

    For i = LBound(tableauResultat, 1) To UBound(tableauResultat, 1)
        ligtab = tableauResultat(i, 2)
        If tableau(ligtab, 6) <> "" And tableau(ligtab, 7) <> "" Then
            For j = tableau(ligtab, 6) To tableau(ligtab, 7) - 1
                If .Range("a6").EntireRow.Find(j) Is Nothing Then
                    .Cells(6, nbcol + 1) = j
                    .Cells(7, nbcol + 1) = tableau(ligtab, 2)
                    nbcol = nbcol + 1
                Else
                    col = .Range("a6").EntireRow.Find(j).Column
                    ligne = .Cells(Rows.Count, col).End(xlUp).Row + 1
                    .Cells(ligne, col) = tableau(ligtab, 2)
                End If
            Next j
        End If
    Next i

End With

End Sub
8rooming-list.xlsm (676.61 Ko)

Bonjour,

Une de tes macro plante au démarrage:

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)

   If ActiveSheet.Name <> "general" Then
       ActiveSheet.Name = "general"
        MsgBox "Vous ne pouvez pas renommer l'onglet !"
    End If
End Sub

Et c'est normal, ne jamais mettre activesheet dans du code de feuille, utilises Me:

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)

   If Me.Name <> "general" Then
       Me.Name = "general"
        MsgBox "Vous ne pouvez pas renommer l'onglet !"
    End If
End Sub

Pour le bug, ça plante à chaque fois que l'on arrive à la ligne clearcontents, où on veut effacer le contenu de la feuille daily, je me demande si c'est la protection qui bloque, mais je ne connais pas le mot de passe, à mon avis on a plusieurs soucis, on veut modifier une feuille masquée qui en plus est protégée, si ça fonctionne en l'affichant et en enlevant sa protection, on pourra alors coder ça.

la feuille "daily" n'est pas protégée

et même lorsqu'elle est visible la macro se bloque.

Par "se bloque" je précise: elle ne bug pas, c'est à dire je ne reçois pas un message d'erreur mais tout simplement la macro bloque toute l'application d'Excel et je dois carrément la fermer de force!

Tous les codes ci dessous fonctionnent- le problème n'est que lorsque j'essaye de lancer la macro nommée "transfer" (ici en gras)

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)

   If Me.Name <> "general" Then
       Me.Name = "general"
        MsgBox "Vous ne pouvez pas renommer l'onglet !"
    End If
End Sub

**********************************************************************************
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect "obrat"

'UPDATE CHOICES IF LIST OF ROOMS CHANGED
 Application.EnableEvents = False

   Dim zone As Range
   Set zone = Range("R8:R17")
   Set zonetest = Range("c3", Range("c" & Rows.Count).End(xlUp))

   If Not Intersect(Target, zone) Is Nothing Then
   temp = Target
   Application.Undo
     While Not zonetest.Find(Target, lookat:=xlWhole) Is Nothing
       Cells(zonetest.Find(Target, lookat:=xlWhole).Row, "c") = temp
       Wend
   Target = temp
   End If

  Application.EnableEvents = True

'AUTOMATICALLY FIT WITDH OF COLUMNS r +c

Application.ScreenUpdating = False
TCol = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11)
FTCol = UBound(TCol)
With ActiveSheet
.Columns("R").AutoFit
For Point = 0 To FTCol
If .Columns(TCol(Point)).ColumnWidth < 10.5 Then
.Columns(TCol(Point)).ColumnWidth = 10.5
End If
Next Point
End With
Application.ScreenUpdating = True

Application.ScreenUpdating = False
TCol = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11)
FTCol = UBound(TCol)
With ActiveSheet
.Columns("C").AutoFit
For Point = 0 To FTCol
If .Columns(TCol(Point)).ColumnWidth < 10 Then
.Columns(TCol(Point)).ColumnWidth = 10
End If
Next Point
End With
Application.ScreenUpdating = True

   ActiveSheet.Protect Password:="obrat", DrawingObjects:=False, AllowFormattingCells:=True
End Sub

     Sub show_daily()

Call transfer

If Sheets("daily").Range("a6") = 0 Then
MsgBox "Vous ne pouvez accéder au détail journalier car il faut au moins un nom de client, une date d'arrivée et une date de départ."
ActiveSheet.Range("A1").Select
Exit Sub

 End If

 If Sheets("daily").Range("a6") <> 0 Then

msg = "Vous allez rentrer dans un onglet non-protégé. Veuillez faire attention de n'y RIEN inscrire manuellement, excepté dans les cellules grises."
    Dialogstyle = vbQuestion + vbYesNo
    Title = "ATTENTION"
    RESPONSE = MsgBox(msg, Dialogstyle, Title)
    If RESPONSE = vbNo Then

    Exit Sub
    End If
    If RESPONSE = vbYes Then
    End If
   End If

Sheets("general").Visible = False
Sheets("daily").Visible = True

Sheets("daily").Activate
Sheets("daily").Range("A1").Select

End Sub

[b]Sub transfer[/b]()

'copy dates and names to daily

Dim WsSource As Worksheet, WsDest As Worksheet
Set WsSource = Sheets("general")
Set WsDest = Sheets("daily")

der_lig = WsSource.Range("a" & Rows.Count).End(xlUp).Row
tableau = WsSource.Range("a3", "n" & der_lig)
Dim tableauResultat
ReDim tableauResultat(1 To UBound(tableau, 1), 1 To 2)
Dim Min(1 To 1, 1 To 3)

'Tri du tableau par date de départ
For i = LBound(tableau, 1) To UBound(tableau, 1)
    tableauResultat(i, 1) = tableau(i, 6)
    tableauResultat(i, 2) = i
Next i

For i = LBound(tableauResultat, 1) To UBound(tableauResultat, 1)
    Min(1, 1) = tableauResultat(i, 1)
    Min(1, 2) = tableauResultat(i, 2)
    Min(1, 3) = i
    For h = i + 1 To UBound(tableauResultat, 1)
        If tableauResultat(h, 1) < Min(1, 1) Then
            Min(1, 1) = tableauResultat(h, 1)
            Min(1, 2) = tableauResultat(h, 2)
            Min(1, 3) = h
        End If
    Next h
    If Min(1, 3) <> i Then
        tableauResultat(Min(1, 3), 1) = tableauResultat(i, 1)
        tableauResultat(Min(1, 3), 2) = tableauResultat(i, 2)
        tableauResultat(i, 1) = Min(1, 1)
        tableauResultat(i, 2) = Min(1, 2)
    End If
Next i
'Tri terminé

'Début de l'export via des boucles
With WsDest

    .Range("a6", .Cells(Rows.Count, Columns.Count)).EntireRow.ClearContents
    .Range("a3", .Cells(Rows.Count, Columns.Count)).EntireRow.ClearContents

    nbcol = 0

    For i = LBound(tableauResultat, 1) To UBound(tableauResultat, 1)
        ligtab = tableauResultat(i, 2)
        If tableau(ligtab, 6) <> "" And tableau(ligtab, 7) <> "" Then
            For j = tableau(ligtab, 6) To tableau(ligtab, 7) - 1
                If .Range("a6").EntireRow.Find(j) Is Nothing Then
                    .Cells(6, nbcol + 1) = j
                    .Cells(7, nbcol + 1) = tableau(ligtab, 2)
                    nbcol = nbcol + 1
                Else
                    col = .Range("a6").EntireRow.Find(j).Column
                    ligne = .Cells(Rows.Count, col).End(xlUp).Row + 1
                    .Cells(ligne, col) = tableau(ligtab, 2)
                End If
            Next j
        End If
    Next i

End With

End Sub

Bonjour,

Oui, comme je le disais, la macro transfer bloque seulement à partir de la ligne de code censée effacer le contenu de la feuille daily.

J'ai juste modifié les lignes:

    .Range("a6", .Cells(Rows.Count, Columns.Count)).EntireRow.ClearContents
    .Range("a3", .Cells(Rows.Count, Columns.Count)).EntireRow.ClearContents

par :

    .Range("a6", .Cells(Rows.Count, Columns.Count)).EntireRow = ""
    .Range("a3", .Cells(Rows.Count, Columns.Count)).EntireRow = ""

Et ça fonctionne à nouveau.

Je te laisse modifier de ton côté

c'est bizarre!

maintenant je rcois un message comme quoi il n'y a pas assez de memoire pour effectuer l'operation, puis un autre message d'erreur (cette fois de VBa) avec le chiffre 400...

J'ai un ordinateur tout neuf ( a peine 3 mois avec une grande memoire).

Re

J'ai oublié de préciser quelque chose

J'évite en général de mettre ce genre de programme dans une feuille, je les place plutôt dans des modules en général, surtout quand je fais appelle à d'autres feuilles

Je te retourne le fichier qui marche chez moi

Rechercher des sujets similaires à "prendre date deux colonnes onglet remettre"