Macro copier si egal rien

Pierrot93

XLDnaute Barbatruc

• 5 Avril 2012

• #2

Re : Macro copier si egal rien

Bonjour,

modifie peut être le test ainsi :

Code:

If IsEmpty(Cellule) Then

bonne journée
@+

 

Vote positif 0 Vote négatif

C

Cazinos

XLDnaute Occasionnel

• 5 Avril 2012

• #3

Re : Macro copier si egal rien

Bonjour,
Merci pour la réponse mais apèrs avoir testé ça ne marche pas
Cazinos

 

Vote positif 0 Vote négatif

tototiti2008

XLDnaute Barbatruc

• 5 Avril 2012

• #4

Re : Macro copier si egal rien

Bonjour Cazinos, Re Pierrot 😉

Alors si tu pouvais nous fournir un bout de fichier exemple pour qu'on puisse vérifier si ta cellule est vide ou non, ça nous aiderait à te répondrre

 

Vote positif 0 Vote négatif

C

Cazinos

XLDnaute Occasionnel

• 5 Avril 2012

• #5

Re : Macro copier si egal rien

Voici un petit fichier qui réprésente la situation de l'original

Merci

Cazinos

 

Pièces jointes

• Classeur1.xls

  25 KB · Affichages: 60
• Classeur1.xls

  25 KB · Affichages: 64
• Classeur1.xls

  25 KB · Affichages: 66

Vote positif 0 Vote négatif

C

Cazinos

XLDnaute Occasionnel

• 7 Avril 2012

• #6

Re : Macro copier si egal rien

Bonjour,

Je vais essayer d'être plus clair dans ma demande de macro

Si la cellule de la colonne "c" égal rien alors rien sinon copier formule
Merci

Cazinos

 

Vote positif 0 Vote négatif

F

frangy

XLDnaute Occasionnel

• 7 Avril 2012

• #7

Re : Macro copier si egal rien

Bonjour,

As-tu essayé avec

Code:

For Each Cellule In Range("C2:C" & Cells(Rows.Count, 3).End(xlUp).Row)

Cordialement.

 

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 7 Avril 2012

• #8

Re : Macro copier si egal rien

Bonjour le fil,

A mon avis il fallait revoir la formule dans la cellule [DEBIT]...

La macro dans le fichier joint :

Code:

Sub Copier()
With Range("C2", Cells(Rows.Count, 3).End(xlUp)).SpecialCells(xlCellTypeConstants)
  Intersect(.EntireRow, [K:K]).FormulaR1C1 = [DEBIT].FormulaR1C1
End With
End Sub

A+

 

Pièces jointes

• Classeur(1).xls

  35.5 KB · Affichages: 54
• Classeur(1).xls

  35.5 KB · Affichages: 64
• Classeur(1).xls

  35.5 KB · Affichages: 51

Vote positif 0 Vote négatif

C

Cazinos

XLDnaute Occasionnel

• 7 Avril 2012

• #9

Re : Macro copier si egal rien

Merci mais :

En fait, seule la cellule "K13" doit avoir une formule car "C13" est vide

Cazinos

 

Vote positif 0 Vote négatif

C

Cazinos

XLDnaute Occasionnel

• 7 Avril 2012

• #10

Re : Macro copier si egal rien

J'ai oublié de m'excuser

En fait, comme l'avez constater, j'ai commis une erreur dans ma demande

C'est uniquement quand une cellule de la colonne "c" est vide qu'il faut copier la formule dans la colonne "k"

Merci

Cazinos

 

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 7 Avril 2012

• #11

Re : Macro copier si egal rien

Re,

Vous ne donnez pas votre avis sur la formule que j'ai mise dans la cellule [DEBIT] en Feuil2...

Mais tant pis, j'espère que cette fois sera la bonne :

Code:

Sub Copier()
Dim plage As Range
[K2].Resize(Rows.Count - 1).ClearContents 'RAZ
On Error Resume Next 'si pas de SpecialCells...
Set plage = [C2].Resize(Rows.Count - 1).SpecialCells(xlCellTypeConstants)
Set plage = Range(plage.Areas(1), plage.Areas(plage.Areas.Count))
Set plage = plage.SpecialCells(xlCellTypeBlanks)
If Err = 0 Then _
  Intersect(plage.EntireRow, [K:K]).FormulaR1C1 = [DEBIT].FormulaR1C1
End Sub

Edit : il manquait le test If Err = 0 Then

Fichier (2).

A+

 

Pièces jointes

• Classeur(2).xls

  37 KB · Affichages: 51
• Classeur(2).xls

  37 KB · Affichages: 42
• Classeur(2).xls

  37 KB · Affichages: 54

Dernière édition: 8 Avril 2012

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 8 Avril 2012

• #12

Re : Macro copier si egal rien

Bonjour le fil, le forum,

La solution (2) ne va pas s'il y a des formules en colonne C.

Celle-ci fonctionne quel que soit le type des valeurs :

Code:

Sub Copier()
Dim plage As Range, cel As Range
[K2].Resize(Rows.Count - 1).ClearContents 'RAZ
On Error Resume Next
Set plage = [C2].Resize(Cells(Rows.Count, 3).End(xlUp).Row - 1)
Set cel = plage.Find("*", , xlFormulas) '1ère cellule non vide
Set plage = cel.Resize(plage.Count - cel.Row + 2)
Set plage = plage.SpecialCells(xlCellTypeBlanks)
If Err = 0 Then _
  Intersect(plage.EntireRow, [K:K]).FormulaR1C1 = [DEBIT].FormulaR1C1
End Sub

A+

 

Pièces jointes

• Classeur(3).xls

  37.5 KB · Affichages: 38
• Classeur(3).xls

  37.5 KB · Affichages: 52
• Classeur(3).xls

  37.5 KB · Affichages: 53

Vote positif 0 Vote négatif

C

Cazinos

XLDnaute Occasionnel

• 8 Avril 2012

• #13

Re : Macro copier si egal rien

Bonjour,

Bon travail !

Merci pour vos participations les 2 macros fonctionnent.

Cazinos

 

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 8 Avril 2012

• #14

Re : Macro copier si egal rien

Re,

Une solution utilisant un tableau VBA (tablo) :

Code:

Sub Copier()
Dim h&, F$, tablo, i&, OK As Boolean
[K2].Resize(Rows.Count - 1).ClearContents 'RAZ
h = Cells(Rows.Count, "C").End(xlUp).Row - 1
If h < 2 Then Exit Sub
F = [DEBIT].FormulaR1C1
tablo = [C2].Resize(h)
For i = 1 To UBound(tablo)
  If Not IsEmpty(tablo(i, 1)) Then OK = True
  tablo(i, 1) = IIf(OK And IsEmpty(tablo(i, 1)), F, "")
Next
[K2].Resize(h) = tablo
End Sub

L'exécution est très rapide même sur de très grands tableaux.

Fichier (4).

A+

 

Pièces jointes

• Classeur(4).xls

  38 KB · Affichages: 54
• Classeur(4).xls

  38 KB · Affichages: 50
• Classeur(4).xls

  38 KB · Affichages: 38

Dernière édition: 8 Avril 2012

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 8 Avril 2012

• #15

Re : Macro copier si egal rien

Re,

J'ai dupliqué le tableau (cellules vertes) jusqu'à la ligne 51001.

Voici les durées d'exécution sur Win XP, Excel 2003 :

- fichier (2) => 4,82 s

- fichier (3) => 2,45 s

- fichier (4) => 0,42 s

La solution par tableau est de loin la plus rapide.

A+

 

Vote positif 0 Vote négatif