Transfert de données d'une ligne d'un fichier vers une colonne d'un autre fichier

**Averell1976** · 18/05/2016, 18h12

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:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
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 Sub