Microsoft 365 Copier/coller à droite ou en bas selon critère

[Markotxe]

Bonjour à tous,
Je veux coller une plage de cellules (Plage) d'une feuille (Feuil1) vers une autre (Feuil2) selon un critère (Nom). Et que cette plage soit collée en bas si le critère est vérifié et à droite si celui-ci ne l'est pas.

Voici les étapes que je suis:
. 1- Sur la feuil1, je définis la plage à copier (set Plage=...). Tout va bien
. 2- Sur la feuil2, je cherche le critère. (Set JS= ... Find …). Tout va bien.
. 3- Si critère non-trouvé, copier/coller à gauche (If JS Is Nothing Then…). Tout va bien (ou presque...)
. 4- Si critère vérifié, copier/coller en dessous (If Not JS Is Nothing Then...) Tout va bien (ou presque...)

Ou presque... car quand les arguments 3 et 4 sont ensembles, un message erreur apparait (erreur "1004"). La partie surlignée est If JS Is nothing. Alors que la macro fonctionne normalement si l'un ou l'autre des deux arguments est absent...
M'enfin?!?... Pourquoi???

Dim H as Range, M as Range
'(H est la première ligne de la plage, M la dernière cellule de la plage)
Dim N as Range ' (N est la cellule qui contient le critère sur Feuil1)
Dim Plage as Range, JS as Range

'''''''''''''''' Défini le critère qui sera recherché'''
Set N=Worksheets("Feuil1").Range("H2") '
'''''''''''''''''''''''''''''''''Défini la plage'''''''''''''''''''''''''
Set Plage=Worksheets("Feuil1").Range(H, M)
''''''''''''''''''''''''''''''Cherche le critère'''''''''''''''''''''''''
Set JS = Worksheets("Feuil2").Range("6:6").Find(N, _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
 
'With Application. etc...

'''''''''''''''''''''''''Si critère non-vérifié, copier/coller (valeurs+formats) à droite''''''''''' 
If JS Is Nothing Then Plage.Copy
With Worksheets("Feuil2").Cells(5, Columns.Count).End(xlToLeft).Offset(0, 2)
                         .PasteSpecial Paste:=xlPasteAllUsingSourceTheme
                         .PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End With

''''''''''''''''''''''''''Si critère vérifié, copier/coller (valeurs+formats) en bas'''''''''''''''''''
If Not JS Is Nothing Then Plage.Copy
With Worksheets("Feuil2").Cells(Rows.Count, JS.Column).End(xlUp).Offset(3, 0)
                         .PasteSpecial Paste:=xlPasteAllUsingSourceTheme
                         .PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
' With Application etc...
End With

Merci pour votre attention.
Cordialement
Marc

 

[jmfmarques]

Bonjour
Rien d'étonnant, dès lors que tes deux blocs With, rendus totalement indépendant de tes instructions If, entrent donc en lice systématiquement ( se surcroît CHACUN DES DEUX) , que JS soit ou non Nothing .

 

[jmfmarques]

Le premier bloc with ne génèrera aucune erreur. Le second en génèrera forcément une (ec JS = nothing)

 

[Markotxe]

Bonjour jmfmarques,
Aaah ok ok, je comprends mieux maintenant.
Merci beaucoup!
Ce soir en rentrant du travail, je testerai tout ça et je vous tiens au courant.
Merci encore!

 

[Markotxe]

Bonjour jmfmarques,
Aaah ok ok, je comprends mieux maintenant.
Merci beaucoup!
Ce soir en rentrant du travail, je testerai tout ça et je vous tiens au courant.
Merci encore!

 

[Markotxe]

Bonsoir à tous,
Et merci encore jmfmarques, ça marche!

Mais j'aurais pas imaginé galérer autant à virer ces "With" et réaliser un simple copier/coller de valeurs et format.
J'ai du mal à comprendre pourquoi excel se complique autant pour réaliser cette opération qui somme toute semble assez anodine. (Toutes ces lignes, ces gardes fous…(?)).
Bref, ça a eu au moins l'avantage de me jeter à la face une bonne dose d'humilité. (J'ai encore beaucoup à apprendre à l'évidence).
Ci-joint le code dont je ne peux dire que je sois super fier (puisque j'ai dû employer la méthode bourrin) mais il a au moins le mérite de fonctionner et est fluide
Sait-on jamais, ça peut dépanner quelqu'un...

Dim H as Range, M as Range
'(H est la première ligne de la plage, M la dernière cellule de la plage)
Dim N as Range ' (N est la cellule qui contient le critère sur Feuil1)
Dim Plage as Range, JS as Range

'''''''''''''''' Défini le critère qui sera recherché'''
Set N=Worksheets("Feuil1").Range("H2") '
'''''''''''''''''''''''''''''''''Défini la plage'''''''''''''''''''''''''
Set Plage=Worksheets("Feuil1").Range(H, M)
''''''''''''''''''''''''''''''Cherche le critère'''''''''''''''''''''''''
Set JS = Worksheets("Feuil2").Range("6:6").Find(N, _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
 
'With Application. etc...

'''Ici un copier/coller bien bourrin des valeurs sur leurs propres emplacement''''
Range(H, M).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'''''''''''''''''''''''''Si critère non-vérifié, copier/coller (bête et méchant) à droite'''''''''''
If JS Is Nothing Then Range(H, M).Copy _
(Worksheets("Feuil2").Cells(5, Columns.Count).End(xlToLeft).Offset(0, 2))
''''''''''''''''''''''''''Si critère vérifié, copier/coller en bas'''''''''''''''''''
If Not JS Is Nothing Then Range(H, M).Copy _
(Worksheets("Feuil2").Cells(Rows.Count, JS.Column).End(xlUp).Offset(3, 0))

En tous les cas merci encore jmfmarques, merci le forum, merci aussi Excel (quand même) et bonne soirée à tous!

Marc

 

[Staple1600]

Bonsoir le fil

Juste histoire de varier les plaisirs
(et parce que j'ai été joué dans mon VBE)

Sub Test_Au_Pif()
Dim p As Range, Z As Range, f1 As Worksheet, f2 As Worksheet
Set f1 = Feuil1: Set f2 = Feuil2: Set Plage = f1.Range("A1:C5")
f1.Range("H2").Name = "XX": Set p = f2.Rows(6)
  If IsError(Application.Match([XX], p, 0)) Then
      col = f2.Cells(5, Columns.Count).End(xlToLeft).Column + 1
      Set Z = f2.Cells(5, col)
      Else
      col = Application.Match([XX], p, 0)
      Set Z = f2.Cells(Rows.Count, col).End(xlUp).Offset(3, 0)
  End If
Plage.Copy Z
End Sub

PS: J'ai testé à l'aveugle (sans fichier exemple)
Donc pas sur que cela fasse ce qu'il faut que cela fasse
Mais au moins , je me suis dégourdi les doigts dans Excel.

 

[Markotxe]

Bonsoir Staple1600,
Votre code est très séduisant, j'aimerais bien le tester (voire l'adopter si fonctionnel).
Cependant j'ai des difficultés à définir les variables...
Plage as Range
mais Col? as integer?

Bon, je m'y penche plus en détail ce soir et je vous tiens au courant.

En tout cas Merci!

 

[Staple1600]

Bonsoir le fil, Markotxe

Dim Plage As Range
Dim col As Long