Couper/coller uniquement les valeurs

Bonjour à tous,

Pouvez-vous m'aider parce que je n'arrive pas à trouver de solution afin de couper une cellule et de le coller uniquement les valeurs?!

Ci-joint un fichier test afin de comprendre ce que je veux.

Je veux couper les noms et les coller dans les cases(uniquement les valeurs)

L'emplacement des noms ne sera jamais fixe.

Merci d'avance.

Setila

Bonjour,

à tester,

Sub Couper_coller()
Dim n As Integer, i As Integer, plg As Range
n = 1
On Error Resume Next
Set plg = Application.InputBox("Sélectionner les noms", Title:="SÉLECTION", Type:=8)

If plg Is Nothing Then MsgBox "Vous n'avez pas fait la sélection": Exit Sub

 For i = 9 To 37 Step 4
   Cells(i, "C") = plg(n)
   Cells(i, "E") = plg(n + 1)
   n = n + 2
 Next
 plg.ClearContents
End Sub

Hello,

Merci, mais ça ne marche pas vraiment.

Le but est que je puisse pendre un ou deux noms dans la liste de noms et de les coller les valeurs n'importe ou dans les cases.

Merci.

Setila

re,

voici un autre exemple pour le déplacement de 1 nom à la fois,

Sub Couper_coller_Un_par_Un()
Dim n As Integer, i As Integer, rng As Range

On Error Resume Next
Set rng = Application.InputBox("Sélectionner le nom", Title:="SÉLECTION", Type:=8)
Set dest = Application.InputBox("Sélectionner la cellule de destination", Title:="SÉLECTION", Type:=8)

If rng Is Nothing Or dest Is Nothing Then MsgBox "Vous n'avez pas fait les sélections": Exit Sub
If rng.Count > 1 Or dest.Count > 1 Then MsgBox "Vous devez sélectionner une seule cellule à la fois": Exit Sub
dest(1) = rng(1).Value

rng.ClearContents
End Sub

re,

un autre version à tester,

Sub Couper_coller2()
Dim n As Integer, i As Integer, plg As Range

On Error Resume Next
Set plg = Application.InputBox("Sélectionner les noms", Title:="SÉLECTION", Type:=8)
Set dest = Application.InputBox("Sélectionner la 1er cellule de destination", Title:="SÉLECTION", Type:=8)

If plg Is Nothing Or dest Is Nothing Then MsgBox "Vous n'avez pas fait les sélections": Exit Sub
 n = dest.Row
 For i = 1 To plg.Count Step 2
   Cells(n, dest.Column) = plg(i)
   Cells(n, dest.Column + 2) = plg(i + 1)
   n = n + 4
 Next
plg.ClearContents
End Sub

Hello,

Génial, le un par un fonctionne super!

Comment faire si j'ai 3 colonnes et que je veux d'abord les remplir dans l'ordre A,B,C

En fessant par un deux ou plusieurs à la fois?

2019 02 21

Setila

Bonjour à tous,

Pour faire simple, ce que je cherche c'est le code suivant mais en CUT:

Sub Copier coller()

Selection.Copy

Selection.PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False

End Sub

Est-ce possible?

Merci d'avance.

Setila

re,

une possibilité pour cellule contiguës uniquement

Sub Couper_coller_CelluleContigue()
Dim n As Integer, i As Integer, plg As Range

On Error Resume Next
Set plg = Application.InputBox("Sélectionner les noms", Title:="SÉLECTION", Type:=8)
Set dest = Application.InputBox("Sélectionner la même qte de cellules pour la destination", Title:="SÉLECTION", Type:=8)

If plg Is Nothing Or dest Is Nothing Then MsgBox "Vous n'avez pas fait la sélection de nom ou de destination": Exit Sub
If plg.Count <> dest.Count Then MsgBox "Les sélections ne sont pas de même dimention, recommencer!": Exit Sub

sens = Application.InputBox("Entrer le sens de la copie:" & Chr(10) & "[v] pour vertical ou [h] pour horizontal", Type:=2)
Select Case sens
 Case "h": Range("" & dest.Address).Value = Application.Transpose(Range("" & plg.Address).Value)
 Case "v": Range("" & dest.Address).Value = Range("" & plg.Address).Value
End Select

'plg.ClearContents  'en commentaire pour le test
End Sub

Hello i20100,

Génial, tu as répondu parfaitement à mon besoin.

Encore une fois, j'apprends énormément en venant sur ce forum.

Merci beaucoup pour ton aide.

Cordialement,

Setila

Rechercher des sujets similaires à "couper coller uniquement valeurs"