Effectuer la macro sur les onglets commencant par

**gilles171** · 21/11/2014, 09h36

Bonjour,

Je voudrais effectuer cette macro sur chaque onglet du classeur commentcant par Valor cependant cela ne semble pas marcher... A priori, le code est bon je ne comprends pas :/ j'ai essayé ces deux facons

For Each Worksheet In ActiveWorkbook.Sheets
If Left(sh.Name, 5) = "Valor" Then

et With Worksheets("Valor") If LCase(Left(Worksheets.Name, 5)) = "Valor" Then

Voici mon code :

Merci beaucoup pour votre aide

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
 
Sub Histo()
 
    Dim Plage As Range
    Dim Cel As Range
 
   For Each Worksheet In ActiveWorkbook.Sheets
   If Left(sh.Name, 5) = "Valor" Then
 
        Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
 
    End With
 
 
    For Each Cel In Plage
 
        'Condition 1) Si colonne A, B, non vide et si colonne F est en % alors copier E dans G
        If Cel.Value <> "" And Cel.Offset(, 1).Value <> "" And Cel.Offset(, 5).NumberFormat = "0.00%" Then
 
 
            Cel.Offset(, 10).Value = Cel.Offset(, 6).Value
 
        'Condition 2 ) Si colonne A, B, non vide, et si colonne F n'est pas en % alors copier F dans G
        ElseIf Cel.Value <> "" And Cel.Offset(, 1).Value <> "" And Cel.Offset(, 5).NumberFormat <> "0%" Then
 
            Cel.Offset(, 10).Value = Cel.Offset(, 5).Value
 
        End If
 
    Next Cel
 
  ActiveWorkbook.Save
    ActiveWorkbook.Close
 
 
End Sub

**vinc_bilb** · 21/11/2014, 10h14

Bonjour,

En fait, je vous suggère dans ce type de pb, de:

1. mettre un point d'arrêt sur la partie qui vous embête
2. de dérouler ensuite le code en mode pas à pas pour voir ce qui se passe

Votre test est bon il me semble, mais que se passe-t-il quand <> "Valor"? Vous avez un " End With" sans With il me semble .... Vous passez peut-être quand même à

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For Each Cel In Plage

Donc, pour un peu que Plage reste définie par la feuille d'avant, vous continuez votre procédure

Il suffit donc juste de remonter le traitement sur "Plage" dans votre partie test, comme

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
  If Left(sh.Name, 5) = "Valor" Then
 
        Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
 
   ' End With C'est quoi???????????????????????????
 
 
    For Each Cel In Plage
 
        'Condition 1) Si colonne A, B, non vide et si colonne F est en % alors copier E dans G
        If Cel.Value <> "" And Cel.Offset(, 1).Value <> "" And Cel.Offset(, 5).NumberFormat = "0.00%" Then
 
 
            Cel.Offset(, 10).Value = Cel.Offset(, 6).Value
 
        'Condition 2 ) Si colonne A, B, non vide, et si colonne F n'est pas en % alors copier F dans G
        ElseIf Cel.Value <> "" And Cel.Offset(, 1).Value <> "" And Cel.Offset(, 5).NumberFormat <> "0%" Then
 
            Cel.Offset(, 10).Value = Cel.Offset(, 5).Value
 
        End If
 
    Next Cel
 
End If

Bonne journée

**gilles171** · 21/11/2014, 10h26

Merci !
Mais en faisant point par point j'ai une erreur de compliation avec une erreur de reference au niveau de .cell de Range(.Cells(2, ..........

En parcourant l'aide je trouve "Un identificateur commençant par un point n'est valide qu'au sein d'un bloc With. Cause et solution de cette erreur : "

Est ce que je devrais mettre ce code ci dessous au sein d'un bloc with et end with pour contourner ce problème ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
If Left(sh.Name, 5) = "Valor" Then
 
        Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))

Très bonne journée également,

**Gado2600** · 21/11/2014, 10h34

Bonjour,

La première partie de ton code ne peut fonctionner tel que c'est écrit.

Essayes par contre, quelque chose comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
dim xlwksheet as worksheet
for each xlwksheet in activeworkbook.sheets
if ucase(xlwksheet.name) like "VALOR*" then
 Set Plage = xlwksheet.Range(xlwksheet.Cells(2, 1), xlwksheet.Cells(xlwksheet.Rows.Count, 1).End(xlUp))
end if
next

Après, je me suis pas attardé sur ton code car j'ai été demandé entre deux...

Cordialement,

**gilles171** · 21/11/2014, 10h50

Hello,

merci mais du coup votre code n'effectue pas mon code peut etre est ce à ucase(xlwksheet.name) like "VALOR*" then qui met tout en Majuscule alors que je voudrais "commencant par Valor et donc qu'il ne reconnait aucun onglet ? Le problème c'est que c'est ca que je ne sais pas faire.
J'ai remplacé Ucase par => mais ca bloque au niveau de Left... je ne comprends pas...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
    Dim Plage As Range
    Dim Cel As Range
  Dim xlwksheet As Worksheet
 
For Each xlwksheet In ActiveWorkbook.Sheets
If Left(xlwksheet.Name) = "Valor" Then
 Set Plage = xlwksheet.Range(xlwksheet.Cells(2, 1), xlwksheet.Cells(xlwksheet.Rows.Count, 1).End(xlUp))
End If
Next

**joe.levrai** · 21/11/2014, 12h20

Bonjour,

ci-après à tester

j'ai nettoyé les coquilles du code et rétabli le bon comportement sur la recopie des cellules pour que le comportement soit celui de tes commentaires

il faut juste ajouter le nom du classeur au début du code, dans l'instanciation de la variable Wb

attention : "valor" ne sera pas détecté, c'est du stricto "Valor" || le format de la cellule en pourcentage doit être avec deux chiffres après la virgule

à toi de nous dire s'il faut assouplir tout ça

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
 
Sub Histo()
 
Dim Plage As Range
Dim Cel As Range
Dim Wb As Workbook
Dim Sh As Worksheet
 
Set Wb = Workbooks("LeNomDeTonClasseur")
 
For Each Sh In Wb.Sheets
 
    If Left(Sh.Name, 5) = "Valor" Then
 
        Set Plage = Sh.Range(Sh.Cells(2, 1), Sh.Cells(Sh.Rows.Count, 1).End(xlUp))
 
        For Each Cel In Plage
 
            'Condition 1) Si colonne A, B, non vide et si colonne F est en % alors copier E dans G
            If Cel.Value <> "" _
            And Cel.Offset(0, 1).Value <> "" _
            And Cel.Offset(0, 5).NumberFormat = "0.00%" Then
 
                Cel.Offset(0, 6).Value = Cel.Offset(0, 4).Value
 
            'Condition 2 ) Si colonne A, B, non vide, et si colonne F n'est pas en % alors copier F dans G
            ElseIf Cel.Value <> "" _
            And Cel.Offset(0, 1).Value <> "" _
            And Cel.Offset(0, 5).NumberFormat <> "0.00%" Then
 
                Cel.Offset(0, 6).Value = Cel.Offset(0, 5).Value
 
            End If
 
        Next Cel
 
    End If
 
Next Sh
 
Set Plage = Nothing
Wb.Close True
 
End Sub

**gilles171** · 21/11/2014, 13h27

Bonjour,

Merci beaucoup !

Cependant il y a une macro initiale qui appelle cette Macro Histo pour effectuer l'action sur une centaine de classeur, donc comment pourrais modifier la ligne Set Wb = Workbooks("LeNomDeTonClasseur"), j'ai essayé ThisWorkbook mais ca ne marche pas..

Merci !

**vinc_bilb** · 21/11/2014, 13h49

Bonjour,

Il faudrait donc la passer avec des paramètres de type Workbook, du style

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub Histo(Wbk As Workbook)
 
Dim Plage As Range
Dim Cel As Range
Dim Wb As Workbook
Dim Sh As Worksheet
 
For Each Sh In Wbk .Sheets
....

et dans la procédure d'appel, le faire de la forme Call Histo(ActiveWorkbook)

**joe.levrai** · 21/11/2014, 13h53

il faudrait voir le contenu de cette macro pour te donner la bonne méthode

mais il faut probablement passer un argument à ta Sub "Histo" qui provient de la macro qui l'appelle

dans ta macro principales, tu affectes le classeur sur lequel il travaille à une variable
et quand on appelle la macro histo, on lui passe le classeur en argument

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Sub MacroPrincipale()
 
' blabla du code
 
' ici j'utilise le classeur où la macro est écrite
' mais il suffit de mettre sous variable le classeur sur lequel ça travaille
' et mettre la variable à la place de ThisWorkBook
Call Histo(ThisWorkbook)
 
' blabla du code
 
End Sub

et la macro histo devient :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
 
Sub Histo(Wb As Workbook)
 
Dim Plage As Range
Dim Cel As Range
Dim Sh As Worksheet
 
For Each Sh In Wb.Sheets
 
    If Left(Sh.Name, 5) = "Valor" Then
 
        Set Plage = Sh.Range(Sh.Cells(2, 1), Sh.Cells(Sh.Rows.Count, 1).End(xlUp))
 
        For Each Cel In Plage
 
            'Condition 1) Si colonne A, B, non vide et si colonne F est en % alors copier E dans G
            If Cel.Value <> "" _
            And Cel.Offset(0, 1).Value <> "" _
            And Cel.Offset(0, 5).NumberFormat = "0.00%" Then
 
                Cel.Offset(0, 6).Value = Cel.Offset(0, 4).Value
 
            'Condition 2 ) Si colonne A, B, non vide, et si colonne F n'est pas en % alors copier F dans G
            ElseIf Cel.Value <> "" _
            And Cel.Offset(0, 1).Value <> "" _
            And Cel.Offset(0, 5).NumberFormat <> "0%" Then
 
                Cel.Offset(0, 6).Value = Cel.Offset(0, 5).Value
 
            End If
 
        Next Cel
 
    End If
 
Next Sh
 
Set Plage = Nothing
Wb.Close True
 
End Sub

**gilles171** · 21/11/2014, 14h48

Bonjour,

Voici ma macro, merci pour vos modifications mais je suis un peu perdu car quand je test pas à pas, elle ouvre bien le premier fichier mais bloque avec un message d'erreur 424 : objet requis $A$2, qu'il n'y avait pas avant :/

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
 
 
Sub Test()
 
 
    Dim Plage As Range, InpRng As Range
    Dim Cel As Range
 
    On Error GoTo Err_Read
 
    Set InpRng = ThisWorkbook.Worksheets("Feuil1").Range("A2:A150").SpecialCells(xlCellTypeConstants)
    Debug.Print InpRng.Address, InpRng.Cells.Count
 
 
 For Each Cel In InpRng
 
If Not (IsEmpty(Cel)) Then
Application.DisplayAlerts = False
   Workbooks.Open CStr((Cel.Value))
   Application.DisplayAlerts = True
   Call Histo(ThisWorkbook)
Else: MsgBox Cel.Address & " invalide"
End If
Next Cel
 
Err_Read:
 
    If Err.Number <> 0 Then
        Errmsg = "Error " & Err.Number & ": " & vbCrLf & Err.Description & vbCrLf & Cel.Address
        MsgBox Errmsg, vbCritical
        Err.Clear
 
        Exit Sub
    End If
    End Sub
 
 
 
 
 
 
 
    Sub Histo(Wb As Workbook)
 
Dim Plage As Range
Dim Cel As Range
Dim Sh As Worksheet
 
For Each Sh In Wb.Sheets
 
    If Left(Sh.Name, 5) = "Valor" Then
 
        Set Plage = Sh.Range(Sh.Cells(2, 1), Sh.Cells(Sh.Rows.Count, 1).End(xlUp))
 
        For Each Cel In Plage
 
            'Condition 1) Si colonne A, B, non vide et si colonne F est en % alors copier E dans G
            If Cel.Value <> "" _
            And Cel.Offset(0, 1).Value <> "" _
            And Cel.Offset(0, 5).NumberFormat = "0.00%" Then
 
                Cel.Offset(, 10).Value = Cel.Offset(, 6).Value
 
            'Condition 2 ) Si colonne A, B, non vide, et si colonne F n'est pas en % alors copier F dans G
            ElseIf Cel.Value <> "" _
            And Cel.Offset(0, 1).Value <> "" _
            And Cel.Offset(0, 5).NumberFormat <> "0%" Then
 
                Cel.Offset(, 10).Value = Cel.Offset(, 5).Value
 
            End If
 
        Next Cel
 
    End If
 
Next Sh
 
Set Plage = Nothing
 
 
 
ActiveWb.Save
    ActiveWb.Close
 
 
End Sub

**vinc_bilb** · 21/11/2014, 15h05

Rebonjour

Je vois plusieurs points qui me semblent douteux ..... identifiés dans votre code ci-dessous par '=> '

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
If Not (IsEmpty(Cel)) Then
Application.DisplayAlerts = False
   Workbooks.Open CStr((Cel.Value))
   Application.DisplayAlerts = True
   Call Histo(ThisWorkbook)
=> Je pense à remplacer par  Call Histo(ActiveWorkbook)
Else: MsgBox Cel.Address & " invalide"
End If
Next Cel
 
Err_Read:
 
    If Err.Number <> 0 Then
        Errmsg = "Error " & Err.Number & ": " & vbCrLf & Err.Description & vbCrLf & Cel.Address
        MsgBox Errmsg, vbCritical
        Err.Clear
 
        Exit Sub
    End If
    End Sub
 
 
    Sub Histo(Wb As Workbook)
 
Dim Plage As Range
Dim Cel As Range
Dim Sh As Worksheet
 
For Each Sh In Wb.Sheets
 
    If Left(Sh.Name, 5) = "Valor" Then
 
        Set Plage = Sh.Range(Sh.Cells(2, 1), Sh.Cells(Sh.Rows.Count, 1).End(xlUp))
 
        For Each Cel In Plage
 
            'Condition 1) Si colonne A, B, non vide et si colonne F est en % alors copier E dans G
            If Cel.Value <> "" _
            And Cel.Offset(0, 1).Value <> "" _
            And Cel.Offset(0, 5).NumberFormat = "0.00%" Then
 
                Cel.Offset(, 10).Value = Cel.Offset(, 6).Value
 
            'Condition 2 ) Si colonne A, B, non vide, et si colonne F n'est pas en % alors copier F dans G
            ElseIf Cel.Value <> "" _
            And Cel.Offset(0, 1).Value <> "" _
            And Cel.Offset(0, 5).NumberFormat <> "0%" Then
 
                Cel.Offset(, 10).Value = Cel.Offset(, 5).Value
 
            End If
 
        Next Cel
 
    End If
 
Next Sh
 
Set Plage = Nothing
 
 
 => C'est faux ci-dessous, et vous l'auriez vu en utilisant l'option explicit :(
ActiveWb.Save
    ActiveWb.Close
 => Wb.Save
=> Wb.Close
 
End Sub

Invité · 21/11/2014, 15h08

Bonjour,
voila comment j'organiserai mon traitement!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub TraitementGeneral()
Dim R As Range
 For Each cel In InpRng
 If Trim("" & cel) <> "" Then TraitementClasseur cel
 Next
End Sub
 
Sub TraitementClasseur(Fichier As String)
Dim wb As Workbook
Dim Sht As Long
Set wb = Workbooks.Open(Fichier)
For Sht = 1 To wb.Sheets.Count
    TraitementSheet wb.Sheets(Sht)
Next
wb.Save
wb.Close False
Set wb = Nothing
 
End Sub
Sub TraitementSheet(Sht As Worksheet)
If UCase(Left(Trim(Sht.Name), 5)) = "VALOR" Then Exit Sub
 
'Suite du traitement....
End Sub

**gilles171** · 21/11/2014, 16h35

Merci !

Cependant elle effectue bien la copie et collage sur tout les onglets commençant par Valor mais, elle bloque quand elle finit le dernier onglet Valor du premier classeur , et ne l'enregistre ni ferme pour ouvrir le second classeur... :/ avec le message d'erreur "424 : objet requis $A$2" à la ligne Err.Clear .

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
If Err.Number <> 0 Then
        Errmsg = "Error " & Err.Number & ": " & vbCrLf & Err.Description & vbCrLf & Cel.Address
        MsgBox Errmsg, vbCritical
        Err.Clear

Que dois je faire svp ? Merci beaucoup

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
 
Sub test()
 
 
    Dim Plage As Range, InpRng As Range
    Dim Cel As Range
 
    On Error GoTo Err_Read
 
    Set InpRng = ThisWorkbook.Worksheets("Feuil1").Range("A2:A150").SpecialCells(xlCellTypeConstants)
    Debug.Print InpRng.Address, InpRng.Cells.Count
 
 
 For Each Cel In InpRng
If Not (IsEmpty(Cel)) Then
Application.DisplayAlerts = False
   Workbooks.Open CStr((Cel.Value))
   Application.DisplayAlerts = True
 
 Call Histo(ActiveWorkbook)
Else: MsgBox Cel.Address & " invalide"
End If
Next Cel
 
Err_Read:
 
    If Err.Number <> 0 Then
        Errmsg = "Error " & Err.Number & ": " & vbCrLf & Err.Description & vbCrLf & Cel.Address
        MsgBox Errmsg, vbCritical
        Err.Clear
 
        Exit Sub
    End If
    End Sub
 
 
    Sub Histo(Wb As Workbook)
 
Dim Plage As Range
Dim Cel As Range
Dim Sh As Worksheet
 
For Each Sh In Wb.Sheets
 
    If Left(Sh.Name, 5) = "Valor" Then
 
        Set Plage = Sh.Range(Sh.Cells(2, 1), Sh.Cells(Sh.Rows.Count, 1).End(xlUp))
 
        For Each Cel In Plage
 
            'Condition 1) Si colonne A, B, non vide et si colonne F est en % alors copier E dans G
            If Cel.Value <> "" _
            And Cel.Offset(0, 1).Value <> "" _
            And Cel.Offset(0, 5).NumberFormat = "0.00%" Then
 
                Cel.Offset(, 10).Value = Cel.Offset(, 6).Value
 
            'Condition 2 ) Si colonne A, B, non vide, et si colonne F n'est pas en % alors copier F dans G
            ElseIf Cel.Value <> "" _
            And Cel.Offset(0, 1).Value <> "" _
            And Cel.Offset(0, 5).NumberFormat <> "0%" Then
 
                Cel.Offset(, 10).Value = Cel.Offset(, 5).Value
 
            End If
 
        Next Cel
 
    End If
 
Next Sh
 
Set Plage = Nothing
 
 
 
ActiveWb.Save
    ActiveWb.Close
 
 
End Sub

Invité · 21/11/2014, 17h16

Quand on commece avec des on error c'est pas bon signe.

Suprimme le et dis nous ou ça bug!

**vinc_bilb** · 22/11/2014, 23h59

Quand on commece avec des on error c'est pas bon signe.

Moi qui croyais programmer proprement avec une gestion saine des erreurs!

Je prends un gros coup .....
rdurupt, vous faites comment concrètement? Je suis preneur

Bonne nuit

Invité · 23/11/2014, 01h14

Bonjour,
je réserve le On Error pour gérer des cas exceptionnels, lecture d'un fichier sur le réseau, envoi vers l’imprimante....

et je referme le on error juste après.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
On Error resume next
set wc= Workbooks.Open("\\192.168.1.1\fichier.xls")
if err<>0 then Msgbox "ERR"
err.clear
on error goto 0

tout les erreur son assujettie à la porté du on error en occurrence On Error GoTo Err_Read.

j'ai découpé le code en 3 parties
1) on ballet la plage contenant le nom des fichier
2) on ouvre le fichier et on ballet les onglets
2) on traite l'onglet

ainsi chaque méthode ne gère que la parti qui la concerne il y a moins de risque de confusion

je ne dis pas qu'in n'y as plus d'erreur mais là on distingue mieux à quel endroit!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
 
Sub Test()
Dim Plage As Range, InpRng As Range
Dim Cel As Range
'On Error GoTo Err_Read
Set InpRng = ThisWorkbook.Worksheets("Feuil1").Range("A2:A150").SpecialCells(xlCellTypeConstants)
Debug.Print InpRng.Address, InpRng.Cells.Count
For Each Cel In InpRn
    If Trim("" & Cel) <> "" Then Histo CStr(Cel) Else MsgBox Cel.Address & " invalide"
Next
 
'Err_Read:
'
'    If Err.Number <> 0 Then
'        Errmsg = "Error " & Err.Number & ": " & vbCrLf & Err.Description & vbCrLf & Cel.Address
'        MsgBox Errmsg, vbCritical
'        Err.Clear
'
'        Exit Sub
'    End If
End Sub
Sub Histo(Fichier As String)
Dim Sh As Worksheet
Dim wb As Workbook
Application.DisplayAlerts = False
Set wb = Workbooks.Open(Fichier)
Application.DisplayAlerts = True
For Each Sh In wb.Sheets
    TraitementSheet Sh
Next
wb.Save
wb.Close
End Sub
Sub TraitementSheet(Sh As Worksheet)
If UCase(Left(Sh.Name, 5)) <> UCase("Valor") Then Exit Sub
Set Plage = Sh.Range(Sh.Cells(2, 1), Sh.Cells(Sh.Rows.Count, 1).End(xlUp))
For Each Cel In Plage
    'Condition 1) Si colonne A, B, non vide et si colonne F est en % alors copier E dans G
 
    If Cel.Value <> "" And Cel.Offset(0, 1).Value <> "" And Cel.Offset(0, 5).NumberFormat = "0.00%" Then
        Cel.Offset(, 10).Value = Cel.Offset(, 6).Value
 
    'Condition 2 ) Si colonne A, B, non vide, et si colonne F n'est pas en % alors copier F dans G
    ElseIf Cel.Value <> "" And Cel.Offset(0, 1).Value <> "" And Cel.Offset(0, 5).NumberFormat <> "0%" Then
        Cel.Offset(, 10).Value = Cel.Offset(, 5).Value
    End If
Next
End Sub

**gilles171** · 24/11/2014, 09h27

Bonjour,

Merci beaucoup !
J'ai donc utilisé votre code en trois étapes (beaucoup plus clair)

Mais il bloque au niveau de For Each Cel In InpRn , le programme demande un objet requis (erreur 424),

je ne connait pas cette fonction InpRn? J'ai cherché ce week end dans l'aide et les differents forums et sur le net je ne trouve pas...

Merci pour l'aide et excellente semaine à tous

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
 
Sub Test()
Dim Plage As Range, InpRng As Range
Dim Cel As Range
'On Error GoTo Err_Read
Set InpRng = ThisWorkbook.Worksheets("Feuil1").Range("A2:A150").SpecialCells(xlCellTypeConstants)
Debug.Print InpRng.Address, InpRng.Cells.Count
For Each Cel In InpRn
    If Trim("" & Cel) <> "" Then Histo CStr(Cel) Else MsgBox Cel.Address & " invalide"
Next
 
'Err_Read:
'
'    If Err.Number <> 0 Then
'        Errmsg = "Error " & Err.Number & ": " & vbCrLf & Err.Description & vbCrLf & Cel.Address
'        MsgBox Errmsg, vbCritical
'        Err.Clear
'
'        Exit Sub
'    End If
End Sub
Sub Histo(Fichier As String)
Dim Sh As Worksheet
Dim wb As Workbook
Application.DisplayAlerts = False
Set wb = Workbooks.Open(Fichier)
Application.DisplayAlerts = True
For Each Sh In wb.Sheets
    TraitementSheet Sh
Next
wb.Save
wb.Close
End Sub
Sub TraitementSheet(Sh As Worksheet)
If UCase(Left(Sh.Name, 5)) <> UCase("Valor") Then Exit Sub
Set Plage = Sh.Range(Sh.Cells(2, 1), Sh.Cells(Sh.Rows.Count, 1).End(xlUp))
For Each Cel In Plage
    'Condition 1) Si colonne A, B, non vide et si colonne F est en % alors copier E dans G
 
    If Cel.Value <> "" And Cel.Offset(0, 1).Value <> "" And Cel.Offset(0, 5).NumberFormat = "0.00%" Then
        Cel.Offset(, 10).Value = Cel.Offset(, 6).Value
 
    'Condition 2 ) Si colonne A, B, non vide, et si colonne F n'est pas en % alors copier F dans G
    ElseIf Cel.Value <> "" And Cel.Offset(0, 1).Value <> "" And Cel.Offset(0, 5).NumberFormat <> "0%" Then
        Cel.Offset(, 10).Value = Cel.Offset(, 5).Value
    End If
Next
End Sub

)

Invité · 24/11/2014, 09h43

Bonjour,
je te assure Excel ne le connait pas non plus, j'avais découpé le code initial mais il y a beaucoup de fautes d'étourderie, l'option explicite t'orrait craché au visage!
test ça

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Option Explicit
Sub Test()
Dim Plage As Range, InpRng As Range
Dim Cel As Range
'On Error GoTo Err_Read
Dim Derl As Long
Derl = ThisWorkbook.Worksheets("Feuil1").Range("A" & Cells.Rows.Count).End(xlUp).Row
Set InpRng = ThisWorkbook.Worksheets("Feuil1").Range("A2:A" & Derl)
Debug.Print InpRng.Address, InpRng.Cells.Count
For Each Cel In InpRng
    If Trim("" & Cel) <> "" Then Histo CStr(Cel) Else MsgBox Cel.Address & " invalide"
Next
End Sub
Sub Histo(Fichier As String)
Dim Sh As Worksheet
Dim wb As Workbook
Application.DisplayAlerts = False
Set wb = Workbooks.Open(Fichier)
Application.DisplayAlerts = True
For Each Sh In wb.Sheets
    TraitementSheet Sh
Next
wb.Save
wb.Close
End Sub
Sub TraitementSheet(Sh As Worksheet)
Dim Plage As Range
Dim Cel As Range
If UCase(Left(Sh.Name, 5)) <> UCase("Valor") Then Exit Sub
Set Plage = Sh.Range(Sh.Cells(2, 1), Sh.Cells(Sh.Rows.Count, 1).End(xlUp))
For Each Cel In Plage
    'Condition 1) Si colonne A, B, non vide et si colonne F est en % alors copier E dans G
 
    If Trim("" & Cel.Value) <> "" And Trim("" & Cel.Offset(0, 1).Value) <> "" And Trim("" & Cel.Offset(0, 5).NumberFormat) = "0.00%" Then
        Cel.Offset(, 10).Value = Cel.Offset(, 6).Value
 
    'Condition 2 ) Si colonne A, B, non vide, et si colonne F n'est pas en % alors copier F dans G
    ElseIf Cel.Value <> "" And Cel.Offset(0, 1).Value <> "" And Cel.Offset(0, 5).NumberFormat <> "0%" Then
        Cel.Offset(, 10).Value = Cel.Offset(, 5).Value
    End If
Next
End Sub

**gilles171** · 24/11/2014, 09h52

Permets moi de te dire un grand merci et que cette macro est parfaite !!

Elle effectue l'action sur chaque onglets sur plus de cents fichiers impeccablement.

Bonne journée !

Invité · 24/11/2014, 11h26

Envoyé par vinc_bilb

Moi qui croyais programmer proprement avec une gestion saine des erreurs!

Je prends un gros coup .....
rdurupt, vous faites comment concrètement? Je suis preneur

Bonne nuit

Bonjour vinc_bilb,
C’est toujours utile de savoir utiliser le On Erro mais on le réserve pour les cas de forces majeur (Déconnexion d’un lecteur réseau, imprimante hors tension, que sais-je…), on prend garde de le débrancher après ON ERROR GOTO 0.

Un message d’erreur est préférable à un fonctionnement erratique !

Nous devons prendre garde que le programme face ce qu’il est sensé faire avant de gérer le exceptions (ERR). C’est pour cela que moi et bien d’autre préconisons de s’abstenir d’en coller dans le code.

Dans le cas qui nous préoccupe le code pouvait rester en l’état, si je l’ai découpé en étape c’est plus pour améliorer ma lisibilité que pour une réelle amélioration.
Un code doit être lisible du Sub au End Sub sans utiliser la barre de défilement ; les retour intempestif à la ligne, contrairement à ce que l’on pourrait croire ne facilite pas la lecture mais nous limite le champ de vision. Pas besoin aérer le code mais au contraire de le tasser.
La découpe en plusieurs méthodes facilite la lecture.
Ici nous avions des erreurs d’étourderie que l’option explicite aurait mise en évidence !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
InpRng As Range
or Each Cel In InpRn
ActiveWb.Save
ActiveWb.Close

Ça ne me rend pas meilleur que les autre rassure toi ; mais j’ai sans doute commis plus d’erreur que les autre, ça m’a redue prudent !
Que mes bourde serve au autre !

Effectuer la macro sur les onglets commencant par [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager