Demande Aide pour une VBA

Résolu

Bonjour ,

Depuis mon fichier source, onglet "Table Départements" je souhaiterais copier le tableau qui s'y trouve en "A1:L98" vers 2 autres fichiers sur les onglet portant le nom également " Table Département" en également "A1:L98".

Fichier source : P:\7 ACTIVITE METRO\22- DIVERS\Analyse et préparation Secteur\Analyse et préparation secteur RS.xlsm

vers

Destination 1 : P:\7 ACTIVITE METRO\8- GESTIONS DES TECHNICIENS\2 - AVIS DE PASSAGE\ADP VP EMLAE envoi auto.xlsm

et vers

Destination 2 : P:\10 ACTIVITE IPFNA\5 - GESTIONS DES TECHNICIENS\1 - AVIS DE PASSAGE\ADP VP IPFNA envoi auto.xlsm

Merci par avance de votre aide
Windows / Chrome 134.0.0.0

6 réponses

  1. Bonjour,

    Je regarde la chose

    0
    1. Re,

      Votre Tableau a des titres de colonnes ou pas?

      0
  2. Bonjour 

    Oui le tableau contient des titres de colonnes entre colonne A et L que je souhaite récupéré également

    0
    1. Re,

      Le tableau est un tableau structure ou pas?

      Je suppose(itoire) qu'il faut faire une raz avant la copie

      0
      1. Oupss je me suis trompé de sujet excusez moi, moi il a la meme structure et oui on peut faire un RAS sur la destination avant la copie

        0
        1. Re,

          Une facon de faire au plus simple.

          Mettre vos chemin de fichier

          Sub Ecriture_ADP()
              Dim Destination_1 As String, Destination_2 As String, Fichier1 As String, Fichier2 As String
              Dim Plage As Range
              
              On Error GoTo Fin
              Application.ScreenUpdating = False
              Set Plage = Worksheets("Table Départements").Range("A1:L98")
              'Destination_1 = "P:\7 ACTIVITE METRO\8- GESTIONS DES TECHNICIENS\2 - AVIS DE PASSAGE\"
              'Destination_2 = "P:\7 ACTIVITE METRO\8- GESTIONS DES TECHNICIENS\1 - AVIS DE PASSAGE\"
              Destination_1 = "E:\_Docs_Prog_Excel\_ADODB_excel\Orang_outanBlanc94\"
              Destination_2 = "E:\_Docs_Prog_Excel\_ADODB_excel\Orang_outanBlanc94\"
              
              Fichier1 = "ADP VP EMLAE envoi auto.xlsm"
              Fichier2 = "ADP VP IPFNA envoi auto.xlsm"
              
              'ADP VP EMLAE envoi auto
              Classeur_Adp = Destination_1 & Fichier1
              Workbooks.Open Classeur_Adp
              With ActiveWorkbook.Worksheets("Table Départements")
                  .Range("A1:L98").ClearContents
                  Plage.Copy .Range("A1")
              End With
              Workbooks(Fichier1).Close savechanges:=True
              
              'ADP VP IPFNA envoi auto.xlsm
              Classeur_Adp = Destination_2 & Fichier2
              Workbooks.Open Classeur_Adp
              With ActiveWorkbook.Worksheets("Table Départements")
                  .Range("A1:L98").ClearContents
                  Plage.Copy .Range("A1")
              End With
              Workbooks(Fichier2).Close savechanges:=True
          Fin:
              If Err.Number <> 0 Then
                  MsgBox "Description erreur: " & Err.Description & vbNewLine & vbNewLine & " Code erreur: " & Err.Number
              End If
              Application.ScreenUpdating = True
          End Sub
          
          0
          1. Merci cela fonctionne

            0