Transfert de ligne par macro

Bonjour,

je voudrais essayer de transférer des lignes d'un fichier sur un autre fichier dont les feuilles ont la même structure
Je vous joins les deux fichiers dont explications dans le 1er
http://www.cjoint.com/c/GKhxq6lV1Om
http://www.cjoint.com/c/GKhxrZmPNom

Par avance merci

4 réponses

  1. je crois que j'y suis arrivé
    j ai changé et j'ai mis cela :

    Sub copie_Plage_01_31()
    Dim wb_a As Workbook, wb_b As Workbook
    Dim Plage As Range
    Dim Chemin As String, no As String
    Dim lb As Long, n As Long

    Application.ScreenUpdating = False
    Chemin = ThisWorkbook.Path
    Set wb_a = ThisWorkbook
    Set wb_b = Workbooks.Open(Filename:=Chemin & "\presse_jour_complet_2016.xlsm")
    DateD = wb_a.Worksheets("01").Range("C7")
    LDateD = wb_b.Worksheets("01").Columns("C").Find(DateD, Cells(1, "C"), , xlWhole).Row
    For n = 1 To 25
    no = Format(n, "00")
    Set Plage = wb_a.Worksheets(no).Range("D7:P5000")
    With wb_b.Worksheets(no)
    .Range("D" & LDateD & ":P" & LDateD + 365) = Plage.Value
    End With
    Next n
    wb_b.Close True
    Application.ScreenUpdating = True
    MsgBox "Mise a jour terminée!!!!!"
    End Sub

    est-ce que c'est bon ?

    merci mille fois , mais j'avais peur de toucher et de casser
    0
    1. Re,

      est-ce que c'est bon ?
      C'est pas mal!!!
      Nom du fichier: - a la place de _
      des lignes en trop et d'autres qui manquent, mais c'est pas mal pour un "debut"

      fichier modifie, mais C6 pas D7, a vous de voir: https://mon-partage.fr/f/gApcY0Fj/
      0
    2. @f894009est ce que les lignes qui manquent
      sont importantes
      si oui veuillez me dire ce que je dois rajouter
      les lignes en trop ne devraient pas géner

      est ce la
      Set Plage = wb_a.Worksheets(no).Range("C6:P5000")
      que je dois mettre C6 ? comme indiqué ?

      merci
      0
    3. @sevy31130Re,

      Regardez ce que j'ai ecrit comme code procedure, j'ai modifie DateD pour que vous n'ayez pas a la modifier dans le code precedent:

      Sub copie_Plage_01_31_Annnee()
          Dim wb_a As Workbook, wb_b As Workbook
          Dim Plage As Range
          Dim Chemin As String, no As String
          Dim lb As Long, n As Long
          Dim DateD As Date
          
          'Application.ScreenUpdating = False
          Chemin = ThisWorkbook.Path
          Set wb_a = ThisWorkbook
          Set wb_b = Workbooks.Open(Filename:=Chemin & "\presse-jour-complet-2016.xlsm")
          DateD = CDate("31/12/" & Year(Date) - 1)     ' date annee-1
          LDateD = wb_b.Worksheets("01").Columns("C").Find(DateD, Cells(1, "C"), , xlWhole).Row + 1    'lignes du 01/01/ annee en cour
          For n = 1 To 25
              no = Format(n, "00")
              Set Plage = wb_a.Worksheets(no).Range("C6:P" & Range("A" & Rows.Count).End(xlUp).Row)   'plage a copier
              LDateF = Plage.Rows.Count    'nombre de ligne plage a copier
              With wb_b.Worksheets(no)
                  .Range("C" & LDateD & ":P" & LDateD + LDateF) = Plage.Value     'transfert plage a la suite
              End With
          Next n
          wb_b.Close True
          Application.ScreenUpdating = True
          MsgBox "Mise a jour terminée!!!!!"
      End Sub
      0
  2. bonjour
    j ai essayé de la lancer et j ai cette erreur
    LDateD = wb_b.Worksheets("01").Columns("C").Find(DateD, Cells(1, "C"), , xlWhole).Row
    merci
    0
    1. Re,

      quand vais-je apprendre, avec mes 76 ans
      Ce n'est pas une carence, mais je ne vais pas vous "torturer" plus longtemps. je vous fais ca
      0
  3. Bonjour,

    oui en effet vous avez raison, quand vais-je apprendre, avec mes 76 ans et 2 opérations de la cataracte demain et dans 8 jours.
    Question: est ce que dans le fichier 20171 si je change le nom du fichier dans cette ligne
    Set wb_b = Workbooks.Open(Filename:=Chemin & "\presse-jour-complet-20171.xlsm")
    et si je met
    Set wb_b = Workbooks.Open(Filename:=Chemin & "\presse_jour_complet_2016.xlsm")
    que dois-je encore changer
    Par avance merci
    0
    1. Bonjour,

      Vous dites que vous ne savez pas faire, quand allez vous apprendre ??

      Dans le fichier 20171, il y a une procedure (que je vous ai ecrite)
      Sub copie_Plage_01_31()

      Manque pas grand chose pour que vous arriviez a faire ce que vous ne savez pas faire
      0