Problème dans une macro d'extraction de données d'un classeur vers un autre

benadry

XLDnaute Occasionnel
Bonjour le forum,

J'ai un petit problème avec une macro qui copie des données d'un tableau vers un autre.

Elle fonctionne très bien, sauf qu'au lieu de copier les données en colonne, elle les copie en ligne !

Par exemple, au lieu de copier les données de A3 à J3, puis de A4 à J4 ..., elle les copie de A3 à A12, puis de A13 à A22 ...

Or, je ne vois pas où mon code est faux. Je pense que c'est au niveau de :
Code:
      cel.Copy .Cells(i + 1, 1)
        i = i + 1
    Next cel
End With


Voici le code :

Code:
Sub Enreg()
Dim chemin As String, Chemin2 As String, Repertoire As String, Fichier As String, Fichier2 As String, Fichier4 As String, Rep As String
Dim pl As Range
Dim i As Long
Dim cel As Range


chemin = "G:\XXXX\YYYY\ZZZZ\AAAA\BBBB\CCCC\"
Chemin2 = ""G:\XXXX\YYYY\ZZZZ\AAAA\BBBB\"

Repertoire = Range("A9").Value & "\"
Fichier = "Fiche anomalieV1.1.xlsm"
Fichier2 = Sheets("Feuil2").Range("E1").Value & ".xlsm"
Fichier4 = "Extraction.xlsx"
ActiveWorkbook.SaveAs Filename:=chemin & Repertoire & Fichier2, FileFormat:=xlOpenXMLWorkbookMacroEnabled

With Sheets("Feuil2")
    'définit la plage pl des données que l’on veut importer
    Set pl = Application.Union(.Cells(8, 5), .Cells(9, 1), .Cells(9, 2), .Cells(9, 5), .Cells(13, 2), .Cells(15, 2), .Cells(15, 5), .Cells(17, 2), .Cells(17, 5))
End With

Workbooks.Open Chemin2 & Fichier4
Application.AskToUpdateLinks = False
ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources
'Workbooks(Chemin2 & Fichier4).Activate

With ActiveWorkbook.Sheets("Feuil1")
i = .UsedRange.Rows.Count 'compte le nombre de lignes déjà utilisées dans ce fichier
    For Each cel In pl
        cel.Copy .Cells(i + 1, 1)
        i = i + 1
    Next cel
End With

ActiveWorkbook.Close SaveChanges:=True
Rep = MsgBox("Voulez-vous revenir au modèle et fermer la présente fiche anomalie ?", vbYesNo + vbQuestion, "Le programme demande votre attention")
If Rep = vbYes Then
    Workbooks.Open Filename:=chemin & Fichier
    Workbooks(Fichier2).Close SaveChanges:=False
End If
End Sub

Si quelqu'un pouvait y regarder ?

Merci d'avance.

Cordialement.
 

benadry

XLDnaute Occasionnel
Re : Problème dans une macro d'extraction de données d'un classeur vers un autre

Bonjour Jean-Marcel,
Bonjour Kingfadhel,

Jean-Marcel : merci pour ton code ; mais ça ne change rien : la macro continue à placer les données extraites dans la colonne A.
Kingfadhel : je veux copier des données suivantes du fichier source (Application.Union(.Cells(8, 5), .Cells(9, 1), .Cells(9, 2), .Cells(9, 5), .Cells(13, 2), .Cells(15, 2), .Cells(15, 5), .Cells(17, 2), .Cells(17, 5))) vers la ligne 3 du classeur de destination.
Puis, quand j'ouvre un autre fichier, recopier les mêmes données sources vers la ligne 4 ...
 

benadry

XLDnaute Occasionnel
Re : Problème dans une macro d'extraction de données d'un classeur vers un autre

Re-,

Merci Jean-Marcel pour ton aide et désolé de ne pas avoir répondu plus tôt. J'étais en réunion.

Comme les données du tableau sont confidentielles, je préfère éviter de les poster. Si besoin, j'anonymiserai, mais si c'est possible autrement, je préfère.

Voici mon nouveau code avec ce que tu m'as donné. Le problème est toujours le même : la macro met tout dans la colonne A.



Code:
Sub Enreg()
Dim chemin As String, Chemin2 As String, Repertoire As String, Fichier As String, Fichier2 As String, Fichier4 As String, Rep As String
Dim pl As Range
Dim i As Long
Dim cel As Range


chemin = "G:\XXXX\YYYY\ZZZZ\AAAA\BBBB\CCCC\"
Chemin2 = ""G:\XXXX\YYYY\ZZZZ\AAAA\BBBB\"


Repertoire = Range("A9").Value & "\"
Fichier = "Fiche anomalieV1.1.xlsm"
Fichier2 = Sheets("Feuil2").Range("E1").Value & ".xlsm"
Fichier4 = "Extraction.xlsx"
ActiveWorkbook.SaveAs Filename:=chemin & Repertoire & Fichier2, FileFormat:=xlOpenXMLWorkbookMacroEnabled

With Sheets("Feuil2")
    'définit la plage pl des données que l’on veut importer
    Set pl = Application.Union(.Cells(8, 5), .Cells(9, 1), .Cells(9, 2), .Cells(9, 5), .Cells(13, 2), .Cells(15, 2), .Cells(15, 5), .Cells(17, 2), .Cells(17, 5))
End With

Workbooks.Open Chemin2 & Fichier4
Application.AskToUpdateLinks = False
ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources
'Workbooks(Chemin2 & Fichier4).Activate

With ActiveWorkbook.Sheets("Feuil1")
i = .UsedRange.Rows.Count 'compte le nombre de lignes déjà utilisées dans ce fichier
décalageColonne = 0
For Each cel In pl
cel.Copy .Cells(i + 1, 1 + décalageColonne)
décalageColonne = décalageColonne + 1
Next cel
End With

ActiveWorkbook.Close SaveChanges:=True
Rep = MsgBox("Voulez-vous revenir au modèle et fermer la présente fiche anomalie ?", vbYesNo + vbQuestion, "Le programme demande votre attention")
If Rep = vbYes Then
    Workbooks.Open Filename:=chemin & Fichier
    Workbooks(Fichier2).Close SaveChanges:=False
End If
End Sub

Merci d'avance.


Cordialement.
 

Discussions similaires

Statistiques des forums

Discussions
311 731
Messages
2 081 993
Membres
101 856
dernier inscrit
Marina40