superbog
XLDnaute Occasionnel
bonjour,
Petit problème de présentation
J'ai une macro qui fonctionne très bien mais je voudrais copier seulement la valeur, de facon à conserver la mise en forme de la plage cible
Sub HR()
Dim i, DerLigBase, Lig As Integer
Dim dossier, sNomFeuille As String
Dim colFeuille As Collection
Dim rCelA As Range
Dim shAct As Worksheet
Dim FeuilleExist As Boolean
'Recherche de la dernière ligne
DerLigBase = Sheets("HR").Range("A999").End(xlUp).Row
Set colFeuille = New Collection
On Error Resume Next
'Boucle sur la plage de cellule
For Each rCelA In Sheets("fact").Range(Cells(2, 1), Cells(DerLigBase, 1))
colFeuille.Add rCelA, CStr(rCelA)
Next rCelA
'Recherche de la ligne et tri dans chaque feuille
For i = 2 To DerLigBase
dossier = Cells(i, 1).Text
Lig = Sheets(dossier).Range("AA999").End(xlUp).Row
'Copie
Sheets("HR").Range("B" & i & ":H" & i).Copy Destination:=Worksheets(dossier).Range("AA" & Lig + 1)
Next i
MsgBox "opération effectuée"
End Sub
merci d'avance
Petit problème de présentation
J'ai une macro qui fonctionne très bien mais je voudrais copier seulement la valeur, de facon à conserver la mise en forme de la plage cible
Sub HR()
Dim i, DerLigBase, Lig As Integer
Dim dossier, sNomFeuille As String
Dim colFeuille As Collection
Dim rCelA As Range
Dim shAct As Worksheet
Dim FeuilleExist As Boolean
'Recherche de la dernière ligne
DerLigBase = Sheets("HR").Range("A999").End(xlUp).Row
Set colFeuille = New Collection
On Error Resume Next
'Boucle sur la plage de cellule
For Each rCelA In Sheets("fact").Range(Cells(2, 1), Cells(DerLigBase, 1))
colFeuille.Add rCelA, CStr(rCelA)
Next rCelA
'Recherche de la ligne et tri dans chaque feuille
For i = 2 To DerLigBase
dossier = Cells(i, 1).Text
Lig = Sheets(dossier).Range("AA999").End(xlUp).Row
'Copie
Sheets("HR").Range("B" & i & ":H" & i).Copy Destination:=Worksheets(dossier).Range("AA" & Lig + 1)
Next i
MsgBox "opération effectuée"
End Sub
merci d'avance