Demande Aide pour une VBA
RésoluOrang-outanBlanc94 Messages postés 72 Statut Membre -
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
-
Bonjour,
Je regarde la chose
-
Bonjour
Oui le tableau contient des titres de colonnes entre colonne A et L que je souhaite récupéré également
-
Re,
Le tableau est un tableau structure ou pas?
Je suppose(itoire) qu'il faut faire une raz avant la copie
-
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
-
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question -
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 -