Copier/coller à la suite et test si ouvert

Bonjour le forum ,

J'ai besoin d'aide pour un petit programme :

J'ai plusieurs fichiers genre A.xlsx B.xlsx et C.xlsx chacun possède un tableau (allant de A1:P19)

J'ai un fichier Global.xlsx avec trois onglet A, B et C

j'aimerai a l'aide de bouton placé dans les trois premiers fichier (A, B et C) pouvoir copier le tableau et l'envoyé dans l'onglet correspondant du fichier Global.

Comme je souhaite le faire plusieurs fois dans le temps je voudrai pouvoir garder l'ancien et coller les tableaux les uns à la suite des autres.

J'aimerai aussi tester si le fichier global.xlsx est ouvert, si non l'ouvrir et si oui pouvoir l'activé pour coller le tableau.

Je met en pièce jointe le fichier global avec les 3 onglets et un fichier A.xlsx pour avoir une idée du tableau.

J'ai un début de code pour juste copier/coller (mais écraser à chaque nouvelle version)

Sub A()
'
' A Macro
'

    Range("A1").Select
    Application.CutCopyMode = False
    Selection.Copy

    Windows("global.xlsx").Activate
    Sheets("A").Select

    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Paste

End Sub
12global.xlsx (8.32 Ko)
14a.xlsm (19.41 Ko)

Bonjour Mika, bonjour le forum,

Essai comme ça (chemin d'accès à adapter à ton cas) :

Sub A()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set CS = ThisWorkbook 'définit la classeur source CS
Set OS = CS.ActiveSheet 'définit l'onglet source OS
CH = ThisWorkbook.Path & "\" 'définit le chemin d'accès du classeur destination (à adapter, ici j'ai considéré qu'il se trouvait dans le même dossier que ce fichier)
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set CD = Workbooks("global.xlsx") 'définit le classeur destination CD (génère un erreur si le classeur n'est pas ouvert)
If Err <> 0 Then 'condition ; si une erreur a été générée
    Workbooks.Open (CH & "global.xlsx") 'ouvre le classeur "global.xlsx"
    Set CD = ActiveWorkbook 'définit la classeur destination CD
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set OD = CD.Sheets("A") 'définit l'onglet destination OD
'définit la cellule de destination DEST (A1 si A1 est vide, sinon la première cellule vide de la colonne A de l'onglet destination)
Set DEST = IIf(OD.Range("A1").Value = "", OD.Range("A1"), OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0))
OS.Rows(1).Copy 'copie la ligne 1 de l'onglet source
'colle la largeur des colonnes de la ligne 1 de l'onglet source dans la ligne de DEST
OD.Rows(DEST.Row).PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
OS.Range("A1:P19").Copy DEST 'copie la plage A1:P19 et la colle dans DEST
End Sub

Salut ThauThème et le forum

Merci bien pour ton aide

juste une dernière question à propose de cette ligne :

CH = ThisWorkbook.Path & "\"

est ce apres le CH = que je met le chemin ? cela remplace donc le thisworkbook.Path ?.

Cdt,

Re,

Oui. Si j'avais pris le temps d'ouvrir ton fichier exemple j'aurais soit écrit :

CH = "C:\Users\mickael.deflorenne\desktop\coco\"

ou alors supprimé la variable CH et écrit :

 Workbooks.Open ("C:\Users\mickael.deflorenne\desktop\coco\global.xlsx") 'ouvre le classeur "global.xlsx"

Okay merci beaucoup

Sujet validé

Rechercher des sujets similaires à "copier coller suite test ouvert"