Donner plusieurs valeurs en même temps à une variable

[anber]

Bonjour,

Je recherche un code pour données plusieurs valeurs à une même variable



Merci

 

[Robert]

Salut Anber, salut le forum,

Le code ci-dessous devrait te satisfaire :

Public Sub test()
Dim cel As Range 'déclare la variable cel
Dim ici As Range 'déclare la variable ici
'boucle sur toutes les cellules non vides de la colonne A (à partir de A4)
For Each cel In Range("A4:A" & Range("A65536").End(xlUp).Row)
'condition 1 : la cellule = A ou B ou C ou D
If cel = "A" Or cel = "B" Or cel = "C" Or cel = "D" Then
'**** Emplacement de la copie****
If Sheets("Feuil2").Range("A4") = "" Then 'si A4 est vide alors...
Set ici = Sheets("Feuil2").Range("A4") 'ici = A4 (onglet "Feuil2")
Else 'sinon...
Set ici = Sheets("Feuil2").Range("A65536").End(xlUp).Offset(1, 0) 'ici= prochaine
End If
'copie la cellule + les 3 adjacentes et les colle "ici"
Range(cel, cel.Offset(0, 3)).Copy Destination:=ici
End If 'fin condition 1
Next cel 'prochaine cellule de la boucle
End Sub

À plus,

Robert

 

[anber]

Bonjour Robert,

Merci ton code fonctionne, il n'y aurait pas aussi une solution avec une variable tableau (array) ??


BA

 

[Robert]

Re Anber

la même pour la colonne B. Je mets en évidence ce qui à changé.

Public Sub test()
Dim cel As Range 'déclare la variable cel
Dim ici As Range 'déclare la variable ici
'boucle sur toutes les cellules non vides de la colonne B (à partir de B4)
For Each cel In Range("B4:B" & Range("B65536").End(xlUp).Row)
'condition 1 : la cellule = A ou B ou C ou D
If cel = "A" Or cel = "B" Or cel = "C" Or cel = "D" Then
'**** Emplacement de la copie****
If Sheets("Feuil2").Range("A4") = "" Then 'si A4 est vide alors...
Set ici = Sheets("Feuil2").Range("A4") 'ici = A4 (onglet "Feuil2")
Else 'sinon...
Set ici = Sheets("Feuil2").Range("A65536").End(xlUp).Offset(1, 0) 'ici= prochaine
End If
'copie la cellule + celle à sa gauche + les deux à sa droite
Range(cel.Offset(0, -1), cel.Offset(0, 2)).Copy Destination:=ici[b/]
End If 'fin condition 1
Next cel 'prochaine cellule de la boucle
End Sub

À plus,

Robert

 

[Robert]

re,

tu supprimeras le [b/] après ici... J'ai inversé, [/b] aurais dû arrêter le gras et ne pas apparaître. Finalement je te remet tout :

Public Sub test()
Dim cel As Range 'déclare la variable cel
Dim ici As Range 'déclare la variable ici
'boucle sur toutes les cellules non vides de la colonne B (à partir de B4)
For Each cel In Range("B4:B" & Range("B65536").End(xlUp).Row)
'condition 1 : la cellule = A ou B ou C ou D
If cel = "A" Or cel = "B" Or cel = "C" Or cel = "D" Then
'**** Emplacement de la copie****
If Sheets("Feuil2").Range("A4") = "" Then 'si A4 est vide alors...
Set ici = Sheets("Feuil2").Range("A4") 'ici = A4 (onglet "Feuil2")
Else 'sinon...
Set ici = Sheets("Feuil2").Range("A65536").End(xlUp).Offset(1, 0) 'ici= prochaine
End If
'copie la cellule + celle à sa gauche + les deux à sa droite
Range(cel.Offset(0, -1), cel.Offset(0, 2)).Copy Destination:=ici
End If 'fin condition 1
Next cel 'prochaine cellule de la boucle
End Sub

À plus,

Robert

 

[anber]

re,

Super Robert, exactement ce qu'il fallait

Encore MERCI

BA