Discussion :

[Sil4s]

Bonjour à tous,

je ne suis pas débutant en VBA mais j'avoue ne pas avoir réussi à trouver avec mes différentes recherches sur internet.

Je crée un excel tous les jours pour différentes vérifications. le format de cet excel ne varie pas. Appelons le DocA

J'aimerai à chaque fin de journée/tache pouvoir simplement faire un copier des données du DocA (uniquement une seule feuille) vers un DocB qui servira d'archive. J'aimerai que le copier du DocA vienne se placer à la suite de ce qu'il y a déjà dans le DocB (archives des jours précédents).

Je viens donc solliciter votre aide et votre temps.
D'avance merci beaucoup

Thomas

[Thautheme]

Bonsoir Thomas, bonsoir le forum,

Comme tu n'as pas daigné nous fournir le moindre renseignement utile je te propose le code générique ci-dessous à adapter. Ce code est à placer dans le fichier DocB qui devrait prendre, par conséquent, l'extension .xlsm :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Macro1()
Dim CD As worksbook 'déclare la variabble CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variabble OD (Onglet Destination)
Dim CA As String 'déclare la variabble CA (Chemin d'Accès)
Dim CS As Workbook 'déclare la variabble CS (Classeur Source)
Dim OS As Worksheet 'déclare la variabble OS (Onglet Source)
Dim DEST As Range 'déclare la variabble DEST (cellule de DESTination)
 
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets(1) 'définit l'onglet destination OD
CA = CD.Path & "\" 'définit le chemin d'accès CA
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set CS = worksbooks("DocA.xlxs") 'définit le classeur source CS (génère une erreur si le classeur n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    Set CS = Workbooks.Open(CA & "DocA.xlsx") 'définit le classeur source en l'ouvrant
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set OS = CS.Worksheets(1) 'définit l'onglet source OS
'définit la cellule de destination DEST (première cellule vide de la colonne A de l'onglet OD)
Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Row + 1
OS.Range("A1").CurrentRegion.Copy DEST 'copy la plage des cellules adjacentes à A1 de l'onglet source et la copie dans dest
End Sub

[Sil4s]

Bonjour Thautheme

tout d'abord Merci pour ta réponse,

je ne voyais pas trop quoi vous donner comme information utile désolé je vais essayer d'être plus claire.

Tous les jours j'ai un fichier excel avec des données sur les colonnes A à M à partir de la ligne 3 jusqu'à la dernière ligne utilisé de A.
J'aimerai faire un copier coller de cette sélection (A3 à M & Dernière ligne) qui se trouve dans le DocA, vers un DocB sur la 2ème ligne après la précédente, la 1ère ligne après la dernière utilisée sera pour y inscrire une date pour que ca fasse comme ceci:

A52 'Données du DocA de la veille
A53 'Donnée du DocA de la veille
A54 'Date à insérer en même temps que le copier coller du jour
A55 'Nouvelles données de DocA à copier à partir de là
A56 'Nouvelles données de DocA
A57 'Nouvelles données de DocA
A58 '...

j'espère avoir été un peu plus précis, j'ai pu regarder ton code, mais je ne suis pas arrivé à l'adapter malheureusement sur le dernier "set".
D'avance merci beaucoup pour ton aide.

Thomas

[Thautheme]

Bonsoir Thomas,

Même principe que dans mon premier post, ce code doit être placé dans le fichier DocB qui prendra l'extension .xlxm puisqu'il contiendra une macro. Il te faudra prenser à vérifier l'extension du fichier DocA. Dans le code je lui est attribué .xlsx, à adapter si ce n'est pas le cas...
Le code va buguer si les deux classeurs ne sont pas dans le même dossier, sauf si les deux classeurs sont ouverts.
Le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub Macro1()
Dim CD As worksbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
 
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets(1) 'définit l'onglet destination OD
CA = CD.Path & "\" 'définit le chemin d'accès CA
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set CS = worksbooks("DocA.xlxs") 'définit le classeur source CS (génère une erreur si le classeur n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    Set CS = Workbooks.Open(CA & "DocA.xlsx") 'définit le classeur source en l'ouvrant
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set OS = CS.Worksheets(1) 'définit l'onglet source OS
DL = OS.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet OS
'définit la cellule de destination DEST (première cellule vide de la colonne A de l'onglet OD)
Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Row + 1
DEST.Value = DateSerial(Year(Date), Month(Date), Day(Date))
OS.Range("A3:M" & DL).Copy DEST.Offset(1, 0) 'copie la plage des cellules de A3 à M... de l'onglet source et la colle une ligne en dessous de DEST
End Sub

[Sil4s]

Bonjour Thautheme

Merci pour ton aide, je comprends mieux le Set en le reprenant le lendemain.
Bonne idée aussi pour le xlsx comme c'est de l'archivage autant réduire le format!

Par contre les deux fichiers ne seront pas dans le même dossier. Le DocA (source qui change tous les jours) est un nouveau fichier créé tous les jours (en partant du fichier de la veille pour garder le format et toutes les macros, je fais un copier coller du fichier de la veille et je "nettoie" les données avec une macro pour le rendre prêt pour la nouvelle journée) et qui va avoir un nouveau dossier tous les mois et année, Le DocB (archive) lui va rester à un endroit fixe et ne bougera plus par la suite (Juste à en créer un nouveau une fois par an).

Est-il possible d'adapter le code pour cela?

Merci d'avance

[Thautheme]

Re,

Si docB est fixe on pourrait mettre la macro dans DocA
Dans ce cas DocB, qui n'a plus de macro devient .xlsx et DocA qui en possèdera une, devient .xlsm.
Il me faudrait le chemin d'accès fixe de DocB ou alors tu l'adaptes dans le code ci-dessous :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CD As worksbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
 
Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Worksheets(1) 'définit l'onglet source OS
CA = "xxx" & "\" 'définit le chemin d'accès CA <==== ici tu écris le chemin d'accès du DocB.xlsx
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set CD = worksbooks("DocB.xlsx") 'définit le classeur destination CD (génère une erreur si le classeur n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    Set CD = Workbooks.Open(CA & "DocB.xlsx") 'définit le classeur destination en l'ouvrant
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set OD = CD.Worksheets(1) 'définit l'onglet destination OD
DL = OS.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet source OS
'définit la cellule de destination DEST (première cellule vide de la colonne A de l'onglet destination OD)
Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Row + 1
DEST.Value = DateSerial(Year(Date), Month(Date), Day(Date)) 'renvoie la date dans DEST
OS.Range("A3:M" & DL).Copy DEST.Offset(1, 0) 'copie la plage des cellules de A3 à M... de l'onglet source et la colle une ligne en dessous de DEST
End Sub