Effectuer la macro sur les onglets commencant par

Version imprimable

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:

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

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:

For Each Cel In Plage

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

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

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

21/11/2014, 10h26
gilles171
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:

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,

Bonjour,

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

Essayes par contre, quelque chose comme ceci :
Code:

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,

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:

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

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:

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

21/11/2014, 13h27
gilles171

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 !
21/11/2014, 13h49
vinc_bilb
Bonjour,

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

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)

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:

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:

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

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:

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

Rebonjour :)

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

Code:

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

Bonjour,
voila comment j'organiserai mon traitement!

Code:

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

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:

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:

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

21/11/2014, 17h16
Invité

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

Suprimme le et dis nous ou ça bug!
22/11/2014, 23h59
vinc_bilb

Citation:

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

Moi qui croyais programmer proprement avec une gestion saine des erreurs!:calim2: Je prends un gros coup .....
rdurupt, vous faites comment concrètement? Je suis preneur

Bonne nuit

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:

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:

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

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:

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

)

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:

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

24/11/2014, 09h52
gilles171

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 !
24/11/2014, 11h26
Invité
Citation:

Envoyé par vinc_bilb

Moi qui croyais programmer proprement avec une gestion saine des erreurs!:calim2: 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:

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 !