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

  • Votes
  • Date
  • Date décroissante
  1. Bonjour,

    Je regarde la chose

    1. Re,

      Votre Tableau a des titres de colonnes ou pas?

  2. Bonjour 

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

    1. Re,

      Le tableau est un tableau structure ou pas?

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

      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

        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