Copier coller entre fichier

Question

Je souhaiterai copier des colonnes sur le fichier test axio v4, cette manip doit s effectuer a partir d une selection de date situé en colonne E Exemple je sélectionne la date du 1er juillet je copie de test axio v4 a prefac les éléments qui apparaissent dans les colonnes en date du 1er juillet ci joint les elements a copier coller 1-copier test axio V4, colonne F =&gt;coller en suivant sur le fichier prefac colonne P 2-copier test axio V4, colonne J =&gt;coller en suivant sur le fichier prefac colonne J 3-copier test axio V4, colonne R =&gt;coller en suivant sur le fichier prefac colonne O 4-copier test axio V4, colonne S =&gt;coller en suivant sur le fichier prefac colonne W 5-copier test axio V4, colonne Y =&gt;coller en suivant sur le fichier prefac colonne G 6-copier test axio V4, colonne Z =&gt;coller en suivant sur le fichier prefac colonne H 7-copier test axio V4, colonne AE =&gt;coller en suivant sur le fichier prefac colonne AE 8-copier test axio V4, colonne AF =&gt;coller en suivant sur le fichier prefac colonne AF 9- copier test axio V4, colonne AG =&gt;coller en suivant sur le fichier prefac colonne AG 10-copier test axio V4, colonne AH=&gt;coller en suivant sur le fichier prefac colonne AH j ai tenté pas mal de chose mais je n y arrive pas actuellement je le fais manuellement merci pour votre aide...

ThauThème · Answer

Attention ! je suis parti de l'hypothèse que les deux classeurs étaient enregistrés dans le même dossier ou que les deux classeurs étaient ouverts avant de lancer la macro... Si j'ai bien compris, le code ci-dessous, à mettre dans le classeur test axio v4 qui prendra, par conséquent l'extension .xlsm , devrait convenir : Sub Macro1() Dim CS As Workbook 'déclare la variable CS (Classeur 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 OS As Worksheet 'déclare la variable OS (Onglet Source) Dim OD As Worksheet 'déclare la variable OD (Onglet Destination) Dim DL As Integer 'déclare la variable DL (Dernière ligne) Dim LR As Integer 'déclare la variable LR (Ligne de Référence) Set CS = ThisWorkbook 'définit la classeur source CS CH = CS.Path &amp; "\" 'définit le chemin d'accès CH On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante Set CD = Workbooks("prefac.xlsx") 'définit le classeur destination CD (génère une erreur si ce classeur né st pas ouvert) If Err &lt;&gt; 0 Then 'condition : si une erreur a été générée Err.Clear 'efface l'erreur Workbooks.Open (CH &amp; "prefac.xlsx") 'ouvre le classeur "prefac.xlsx" Set CD = ActiveWorkbook 'définit le classeur destination CD End If 'fin de la condition On Error GoTo 0 'annulela gestion des erreur Set OS = CS.Sheets("Feuil1") 'définit l'onglet source OS Set OD = CD.Sheets("Feuil1") 'définit l'onglet destination OD DL = OS.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet source LR = OD.Cells(Application.Rows.Count, 1).End(xlUp).Row + 1 'définit la première ligne vide LR de la colonne 1 (=A) de l'onglet destination OD 'copie des plages OS.Range(OS.Cells(3, "F"), OS.Cells(DL, "F")).Copy OD.Cells(LR, "P") 'copie la colonne F de la source dans la colonne P de la destination OS.Range(OS.Cells(3, "J"), OS.Cells(DL, "J")).Copy OD.Cells(LR, "J") 'copie la colonne J de la source dans la colonne J de la destination OS.Range(OS.Cells(3, "R"), OS.Cells(DL, "R")).Copy OD.Cells(LR, "O") 'copie la colonne R de la source dans la colonne O de la destination OS.Range(OS.Cells(3, "S"), OS.Cells(DL, "S")).Copy OD.Cells(LR, "W") 'copie la colonne S de la source dans la colonne W de la destination OS.Range(OS.Cells(3, "Y"), OS.Cells(DL, "Y")).Copy OD.Cells(LR, "G") 'copie la colonne Y de la source dans la colonne G de la destination OS.Range(OS.Cells(3, "Z"), OS.Cells(DL, "Z")).Copy OD.Cells(LR, "H") 'copie la colonne Z de la source dans la colonne H de la destination OS.Range(OS.Cells(3, "AE"), OS.Cells(DL, "AH")).Copy OD.Cells(LR, "AE") 'copie la plage AE:AH de la source dans la colonne AE de la destination End Sub Re, Arf ! J'ai relu et vu qu'il y avait un critère de date... Code à revoir complètement mais là je n'ai plus le temps... Plus tard ...

Invité · Answer

@ThauThème, je me permets d'attirer ton attention sur tes déclarations de variables "Integer" pour les lignes Un "Integer" en VBA prend les valeurs de -32.768 à 32767, or le nombre de ligne est bien plus grand Tu auras donc à un moment donné une erreur 6 : Dépassement de capacité Petit test pour te démontrer Sub Test() Dim DL As Integer ' Dernière ligne DL = Range("A1").End(xlDown).Row End Sub A+...

ThauThème · Answer

@Bruno Juste une question d'habitude car les tableaux de plus de 32 767 ligne sont assez rares et je n'utilise pratiquement jamais xlDown pour atteindre la dernière ligne éditée d'une colonne. Mais tu as tout à fait raison... @Serge Je ne lâche pas l'affaire.....

ThauThème · Answer

Re,

Voici une nouvelle proposition qui devrait convenir :

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 DL As Integer 'déclare la variable DL (Dernière ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim PLV As Range 'déclare la variable PLV (PLage Visible)
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 LR As Integer 'déclare la variable LR (Ligne de Référence)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CS = ThisWorkbook 'définit la classeur source CS
Set OS = CS.Sheets("Feuil1") 'définit l'onglet source OS
CS.Activate 'actice le classeur source CS
OS.Select 'active l'onglet source OS
If Not IsDate(ActiveCell) = True Or ActiveCell.Column <> 5 Then 'condition : si la cellule active n'est pas une date
    MsgBox "Vous devez sélectionner la date de référence dans la colonne E !" 'message
    Range("E3").Select 'sélectionne la cellule E3
    Exit Sub 'sort de la procédure
End If 'fin de la condition
DL = OS.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet source OS
Set PL = OS.Range("A3:AH" & DL) 'définit la plage PL (le tableau sans la première ligne)
'filtre le tableau par rapport à la colonne E avec la date de la cellule active comme critère
OS.Range("A2").AutoFilter Field:=5, Criteria1:=Format(DateSerial(Year(ActiveCell.Value), Month(ActiveCell.Value), Day(ActiveCell.Value)), "dd/mm/yyyy")
Set PLV = PL.SpecialCells(xlCellTypeVisible) 'définit la plage PLV (la plage PL visible après le filtre)
CH = CS.Path & "\" 'définit le chemin d'accès CH
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante
Set CD = Workbooks("prefac.xlsx") 'définit le classeur destination CD (génère une erreur si ce classeur né st pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'efface l'erreur
    Workbooks.Open (CH & "prefac.xlsx") 'ouvre le classeur "prefac.xlsx"
    Set CD = ActiveWorkbook 'définit le classeur destination CD
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set OD = CD.Sheets("Feuil1") 'définit l'onglet destination OD
LR = OD.Cells(Application.Rows.Count, 16).End(xlUp).Row + 1 'définit la ligne de référence LR par rapport à la colonne 16 (=P) de l'onglet OD
Application.Intersect(PLV, OS.Columns("F:F")).Copy OD.Cells(LR, "P") 'copie la colonne F visible de la source dans la colonne P de la destination
Application.Intersect(PLV, OS.Columns("J:J")).Copy OD.Cells(LR, "J") 'copie la colonne J visible de la source dans la colonne J de la destination
Application.Intersect(PLV, OS.Columns("R:R")).Copy OD.Cells(LR, "O") 'copie la colonne R visible de la source dans la colonne O de la destination
Application.Intersect(PLV, OS.Columns("S:S")).Copy OD.Cells(LR, "W") 'copie la colonne S visible de la source dans la colonne W de la destination
Application.Intersect(PLV, OS.Columns("Y:Z")).Copy OD.Cells(LR, "G") 'copie la plage Y:Z visible  de la source dans la colonne G de la destination
Application.Intersect(PLV, OS.Columns("AE:AH")).Copy OD.Cells(LR, "AE") 'copie la plage AE:AH visible de la source dans la colonne AE de la destination
OS.Range("A2").AutoFilter 'supprime le filte automatique
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

Pour automatiser au double-clic tu peux :

• Copier le code ci-dessus dans une module standard nommé Module 1

• Dans le composant VBA de l'onglet Feuil1 [Feuil(Feuil1)] du classeur source, tu copies la procédure événementielle ci-dessous :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Module1.Macro1 'lance la procédure "Macro1" du module [Module1]
Cancel = True 'empêche le mode édition lié au double-clic
End Sub

Ainsi, en double-cliquant sur une date de la colonne E, la procédure se lance automatiquement...

ThauThème · Answer

Moi je n'ai que tes deux premiers fichiers pour tester et ça marche. Je ne pourrais pas t'en dire plus sans les nouveaux fichiers.....

ThauThème · Answer

Re, Je ne pourrais malheureusement t'aider qu'avec les fichiers. Si ils sont confidentiels ou trop volumineux, envoie-les par mail perso.....