Averell1976
XLDnaute Junior
Bonjour à toutes et à tous,
J'ai posé un sujet il y a quelques temps. J'ai reçu de l'aide de votre part et je vous en remercie vivement, mais je coince toujours. Je n'avais pas de code à vous proposer, mais aujourd'hui, j'ai quelque peu avancé. Je peux donc vous le soumettre. J’avais mis les fichiers en PJ mais je comprends que cela puisse poser problème.
L'objectif est de transférer des données (en lignes) d'un fichier, compris entre 2 dates vers une colonne d'un autre fichier:
Merci de votre aide éventuelle.
Cordialement,
Averell
J'ai posé un sujet il y a quelques temps. J'ai reçu de l'aide de votre part et je vous en remercie vivement, mais je coince toujours. Je n'avais pas de code à vous proposer, mais aujourd'hui, j'ai quelque peu avancé. Je peux donc vous le soumettre. J’avais mis les fichiers en PJ mais je comprends que cela puisse poser problème.
L'objectif est de transférer des données (en lignes) d'un fichier, compris entre 2 dates vers une colonne d'un autre fichier:
Code:
Private Sub GenererPlanning_Jour_Click()
'J'ouvre un userform et je renseigne la date de début et la date de fin pour récupérer toutes les données entre ces 2 dates
Application.ScreenUpdating = False
Set Fdép = ActiveSheet
Dte1 = DateValue(Right(TextBox1, 10))
Dte2 = DateValue(Right(TextBox2, 10))
If Dte2 < Dte1 Then
MsgBox " Mauvaise saisie !" & Chr(13) & " La date de fin doit être postérieure à celle de début ! ", 16
Exit Sub
End If
LnNom = ComboBox1.ListIndex + 11
NbreMois = Month(Dte2) - Month(Dte1)
If NbreMois < 0 Then NbreMois = NbreMois + 13
NomMois = Array("JANVIER", "FéVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOÛT", "SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DéCEMBRE")
Chemin = ThisWorkbook.Path & "\"
If TextBox1 = "" Or TextBox2 = "" Then
MsgBox " Vous devez saisir une date de début et une date de " & Chr(13) & " fin de remplacement.", 16
Exit Sub
End If
'On ouvre le planning du remplaçant (le fichier dans lequel je veux copier les données en colonne)
Application.DisplayAlerts = False
'Workbooks.Open Filename:=Chemin & "MATRICE PLANNING JOUR PREVISIONNEL INDIVIDUEL.xlsm"
Workbooks.Open Filename:="O:\Cecile BALANDRAUD\MATRICES\MATRICE PLANNING_FL\FL Melting1.xlsm"
Set DocDest = ActiveWorkbook
ActiveSheet.Name = NomMois(Month(Dte1) - 1)
'Range("A1").Value = Fdép.Cells(LnNom + 1, 2).Value
'Range("A2").Value = "qui remplace " & ComboBox1
'On affiche le mois de début de remplacement dans ce fichier qui s'est ouvert
Fdép.Range("Z2").Value = NomMois(Month(Dte1) - 1)
Fdép.Range("AC2").Value = Year(Dte1)
DocDest.Sheets(NomMois(Month(Dte1) - 1)).Range("O10").Value = NomMois(Month(Dte1) - 1)
'''''''''''
DocDest.Sheets(NomMois(Month(Dte1) - 1)).Range("O8").Value = Year(Dte1)
' Dernière colonne du mois
For i = 3 To 34
If Fdép.Cells(9, i).Value = "" Then
Exit For
End If
Next i
DerCol = i - 1
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'On copie les jours de remplacement dans le planning du remplaçant; c'est là que ça coince
For Col = 3 To DerCol
For Lign = 21 To 51
If Fdép.Cells(9, Col).Value >= Dte1 And Fdép.Cells(9, Col).Value <= Dte2 Then
'If DocDest.Sheets(NomMois(Month(Dte1) - 1)).Cells(Lign, 1).Value >= Dte1 And DocDest.Sheets(NomMois(Month(Dte1) - 1)).Cells(Lign, 1).Value <= Dte2 Then
Fdép.Cells(LnNom, Col).Copy
DocDest.Sheets(NomMois(Month(Dte1) - 1)).Cells(Lign, 3).PasteSpecial xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True 'selection un collage special => transposé permet de passer de ligne en colonne
Application.CutCopyMode = False
End If
Next Lign
Next Col
Unload Me
''''''''''''''''''''''''''''''''''''''''''
End SubMerci de votre aide éventuelle.
Cordialement,
Averell
.
