Problème pour copier et coller des données avec une macro Excel

benadry

XLDnaute Occasionnel
Rebonjour le forum,


Je travaille sur une macro (toujours sur la même pour ceux qui ont lu les messages précédents !) qui permet d'extraire des données d'un fichier Excel vers un autre.

Après avoir beaucoup tâtonné et vous avoir aussi pas mal sollicité, j'ai obtenu un code qui fonctionne très bien, sous deux réserves :

1°) au lieu de faire un simple copier-coller, je voudrais faire un collage spécial sur la valeur.
En effet, Excel colle les données avec la mise en forma conditionnelle du fichier d'origine, ce qui est très gênant. Une solution de contournement consisterait à supprimer toute mise en forme conditionnelle ou mise en gras ... après avoir copié la ligne.

2°) Par ailleurs, il me semble que le code ci-dessous permet de coller les données sur la même ligne. Or, il les colle sur la même colonne !

Si quelqu'un a une idée ...


Bien cordialement.


Voici le code en question :


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:\XXX\YYY\ZZZ\AAA\BBB\CCC\"
Chemin2 = "G:\XXX\YYY\ZZZ\AAA\BBB\"

Repertoire = Range("A9").Value & "\"
Fichier = "Fiche anomalieModèle.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
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof