Collage spécial en valeur
Bonjour à tous,
Après une nuit de réflexion j'ai avancé mon sujet de suivi de chantier avec une fonction permettant de copier/coller des items dans l'onglet (zone) qui leur appartient. (Merci Yvouille
Je souhaiterai par contre avoir un collage spécial en valeur pour garder la mise en forme de mon tableau de destination.
Ci-dessous le bout de code qui me permet de réaliser ma fonction :
Sub copy_item_to_zone()
Dim Wb_dest As String
Dim Wb_dep As String
Dim loc As String
Dim i, p As Integer
Wb_dep =
Sheets("zone").Select
For p = 6 To Workbooks(Wb_dep).Sheets(1).Range("A65536").End(xlUp).Row
Sheets("zone").Select
loc = Cells(p, 1)
Sheets("Pré-Montage").Select
Ligne = 5
For i = 2 To Workbooks(Wb_dep).Sheets(4).Range("E65536").End(xlUp).Row
If Workbooks(Wb_dep).Sheets(4).Range("E" & i) = loc Then
Workbooks(Wb_dep).Sheets(4).Range("E" & i & ":F" & i).copy Workbooks(Wb_dep).Sheets(loc).Range("A" & Ligne)
Workbooks(Wb_dep).Sheets(4).Range("M" & i).copy Workbooks(Wb_dep).Sheets(loc).Range("C" & Ligne)
Ligne = Ligne + 1
End If
Next i
Next p
End Sub
à ajouter après la déclaration des variables
Wb_dep = activation du fichier (moins de 10 msg pour que cette ligne soit accepté ...)
Bonne journée à vous
J'ai trouvé comme un grand
Pas très élégant mais fonctionne !
Sub copy_item_to_zone() ' Série de Macro réalisé le 01/2020 par PP
Dim Wb_dest As String
Dim Wb_dep As String
Dim loc As String
Dim i, p As Integer
Dim sPass As String
Sheets("zone").Select
For p = 6 To Workbooks(Wb_dep).Sheets(1).Range("A65536").End(xlUp).Row
Sheets("zone").Select
loc = Cells(p, 1)
Sheets("Pré-Montage").Select
Ligne = 5
For i = 2 To Workbooks(Wb_dep).Sheets(4).Range("E65536").End(xlUp).Row
If Workbooks(Wb_dep).Sheets(4).Range("E" & i) = loc Then
Workbooks(Wb_dep).Sheets(4).Range("E" & i & ":F" & i).copy
Workbooks(Wb_dep).Sheets(loc).Range("A" & Ligne).PasteSpecial Paste:=xlPasteValues
Workbooks(Wb_dep).Sheets(4).Range("M" & i).copy
Workbooks(Wb_dep).Sheets(loc).Range("C" & Ligne).PasteSpecial Paste:=xlPasteValues
Ligne = Ligne + 1
End If
Next i
Next p
Sheets("zone").Select
End If
End Sub
Quelqu'un aurait il une suggestion pour que la copie se fasse que si l'item n'était pas déjà ajouter dans la zone ?