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 :
Voici le code :
Si quelqu'un pouvait y regarder ?
Merci d'avance.
Cordialement.
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.