Bonjour,
Je viens vers vous suite à une erreur lors de l'execution d'une macro que j'ai essayé de faire.
Mon niveau debutant fait que j'ai besoin de vos competences d'expert.
Sur un fichier, j'ai plusieurs macros qui fonctionne par des boutons. Je souhaiterai les faire fonctionner par un seul bouton.
Entre chaque macro j'ai utilisé la fonction "Call ..."
Mais j'ai une erreur qui s'affiche:
Voici ma macro:
Sub ???
call ???Bouton1_Cliquer()
Dim sh, a, DernCol As Integer
Dim Wb_dest As String
Dim Wb_dep As String
Application.ScreenUpdating = False
Wb_dep = ActiveWorkbook.Name
For sh = 3 To Workbooks(Wb_dep).Sheets.Count
Ligne = 2
For a = 2 To Workbooks(Wb_dep).Sheets(sh).Range("A65536").End(xlUp).Row
If Workbooks(Wb_dep).Sheets(sh).Range("A" & a) = "YES" Then
Workbooks(Wb_dep).Sheets(sh).Range("C" & a).COPY Workbooks(Wb_dep).Sheets(8).Range("A" & Ligne)
Workbooks(Wb_dep).Sheets(sh).Range("D" & a).COPY Workbooks(Wb_dep).Sheets(8).Range("D" & Ligne)
Workbooks(Wb_dep).Sheets(sh).Range("H" & a).COPY Workbooks(Wb_dep).Sheets(8).Range("C" & Ligne)
Ligne = Ligne + 1
End If
Next a
Next sh
Call ???_Bouton1_Cliquer()
Dim sh, a, DernCol As Integer
Dim Wb_dest As String
Dim Wb_dep As String
Application.ScreenUpdating = False
Wb_dep = ActiveWorkbook.Name
For sh = 2 To Workbooks(Wb_dep).Sheets.Count
Ligne = 2
For a = 2 To Workbooks(Wb_dep).Sheets(sh).Range("A65536").End(xlUp).Row
If Workbooks(Wb_dep).Sheets(sh).Range("D" & a) = "N" Then
Workbooks(Wb_dep).Sheets(sh).Range("F" & a).COPY Workbooks(Wb_dep).Sheets(7).Range("A" & Ligne)
Workbooks(Wb_dep).Sheets(sh).Range("G" & a).COPY Workbooks(Wb_dep).Sheets(7).Range("B" & Ligne)
Workbooks(Wb_dep).Sheets(sh).Range("C" & a).COPY Workbooks(Wb_dep).Sheets(7).Range("C" & Ligne)
Ligne = Ligne + 1
End If
Next a
Next sh
call Bouton2_Cliquer()
Dim Cel As Range
Dim Trouve As Boolean
Dim Lettre As Boolean
Dim Pos As Integer
Dim Col As Integer
Dim I As Integer
Dim Msg As String
Dim Chaine As String
Dim Chiffres As String
Columns("E:F").ClearContents
Chiffres = "0123456789,-+"
For Each Cel In Range("D2 1000" & Range("A65536").End(xlUp).Row)
Trouve = False
Col = 5
Lettre = False
Msg = ""
Chaine = Trim(Cel.Text)
For I = 1 To Len(Chaine)
If InStr(1, Chiffres, Mid(Chaine, I, 1)) > 0 Then
If Lettre = False Then
Msg = Msg & Mid(Chaine, I, 1)
Else
If Trouve = False Then
If Trim(Msg) <> "" Then
Cells(Cel.Row, Col) = Msg
Col = Col + 1
End If
Msg = ""
Trouve = True
Pos = I
End If
End If
Else
If Trouve = True Then
Cells(Cel.Row, Col) = CDbl(Mid(Chaine, Pos, I - Pos))
Col = Col + 1
Trouve = False
Else
Lettre = True
Msg = Msg & Mid(Chaine, I, 1)
End If
End If
Next I
If Trouve = True Then
Cells(Cel.Row, Col) = CDbl(Mid(Chaine, Pos, I - Pos))
End If
Next Cel
Columns("E:F").AutoFit
call Bouton3_Cliquer()
Sheets("???").Columns("F").COPY Sheets("???").Columns(2)
call regrouperVOSPDealerpoint_Bouton1_Cliquer()
Dim debut As Integer
nb = Sheets.Count
Set ws1 = Sheets("regrouper ??? ???")
dl1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws1.Range("A2", "BE" & dl1).ClearContents
On Error GoTo fin
debut = InputBox("Combien d'onglet voulez vous regrouper en partant de la derniere feuille ?") - 1
For I = nb To nb - debut Step -1
dl1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row + 1
Set ws = Sheets(I)
dl = ws.Cells(Rows.Count, 1).End(xlUp).Row
ws.Range("A2", "BE" & dl).COPY Destination:=ws1.Cells(dl1, 1)
Next I
MsgBox "Mise à jour effectuée"
fin:
call ???_Bouton3_Cliquer()
Dim sh, a, DernCol As Integer
Dim Wb_dest As String
Dim Wb_dep As String
Application.ScreenUpdating = False
Wb_dep = ActiveWorkbook.Name
For sh = 6 To Workbooks(Wb_dep).Sheets.Count
Ligne = 4
For a = 2 To Workbooks(Wb_dep).Sheets(sh).Range("A65536").End(xlUp).Row
If Workbooks(Wb_dep).Sheets(sh).Range("H" & a) = "1" Then
Workbooks(Wb_dep).Sheets(sh).Range("C" & a).COPY Workbooks(Wb_dep).Sheets(5).Range("C" & Ligne)
Workbooks(Wb_dep).Sheets(sh).Range("A" & a).COPY Workbooks(Wb_dep).Sheets(5).Range("D" & Ligne)
Workbooks(Wb_dep).Sheets(sh).Range("B" & a).COPY Workbooks(Wb_dep).Sheets(5).Range("E" & Ligne)
Ligne = Ligne + 1
End If
Next a
Next sh
End Sub
Voici mon message d'erreur:
Ayant un petit niveau, je bloque
Merci d'avance de votre aide
Je viens vers vous suite à une erreur lors de l'execution d'une macro que j'ai essayé de faire.
Mon niveau debutant fait que j'ai besoin de vos competences d'expert.
Sur un fichier, j'ai plusieurs macros qui fonctionne par des boutons. Je souhaiterai les faire fonctionner par un seul bouton.
Entre chaque macro j'ai utilisé la fonction "Call ..."
Mais j'ai une erreur qui s'affiche:
Voici ma macro:
Sub ???
call ???Bouton1_Cliquer()
Dim sh, a, DernCol As Integer
Dim Wb_dest As String
Dim Wb_dep As String
Application.ScreenUpdating = False
Wb_dep = ActiveWorkbook.Name
For sh = 3 To Workbooks(Wb_dep).Sheets.Count
Ligne = 2
For a = 2 To Workbooks(Wb_dep).Sheets(sh).Range("A65536").End(xlUp).Row
If Workbooks(Wb_dep).Sheets(sh).Range("A" & a) = "YES" Then
Workbooks(Wb_dep).Sheets(sh).Range("C" & a).COPY Workbooks(Wb_dep).Sheets(8).Range("A" & Ligne)
Workbooks(Wb_dep).Sheets(sh).Range("D" & a).COPY Workbooks(Wb_dep).Sheets(8).Range("D" & Ligne)
Workbooks(Wb_dep).Sheets(sh).Range("H" & a).COPY Workbooks(Wb_dep).Sheets(8).Range("C" & Ligne)
Ligne = Ligne + 1
End If
Next a
Next sh
Call ???_Bouton1_Cliquer()
Dim sh, a, DernCol As Integer
Dim Wb_dest As String
Dim Wb_dep As String
Application.ScreenUpdating = False
Wb_dep = ActiveWorkbook.Name
For sh = 2 To Workbooks(Wb_dep).Sheets.Count
Ligne = 2
For a = 2 To Workbooks(Wb_dep).Sheets(sh).Range("A65536").End(xlUp).Row
If Workbooks(Wb_dep).Sheets(sh).Range("D" & a) = "N" Then
Workbooks(Wb_dep).Sheets(sh).Range("F" & a).COPY Workbooks(Wb_dep).Sheets(7).Range("A" & Ligne)
Workbooks(Wb_dep).Sheets(sh).Range("G" & a).COPY Workbooks(Wb_dep).Sheets(7).Range("B" & Ligne)
Workbooks(Wb_dep).Sheets(sh).Range("C" & a).COPY Workbooks(Wb_dep).Sheets(7).Range("C" & Ligne)
Ligne = Ligne + 1
End If
Next a
Next sh
call Bouton2_Cliquer()
Dim Cel As Range
Dim Trouve As Boolean
Dim Lettre As Boolean
Dim Pos As Integer
Dim Col As Integer
Dim I As Integer
Dim Msg As String
Dim Chaine As String
Dim Chiffres As String
Columns("E:F").ClearContents
Chiffres = "0123456789,-+"
For Each Cel In Range("D2
Trouve = False
Col = 5
Lettre = False
Msg = ""
Chaine = Trim(Cel.Text)
For I = 1 To Len(Chaine)
If InStr(1, Chiffres, Mid(Chaine, I, 1)) > 0 Then
If Lettre = False Then
Msg = Msg & Mid(Chaine, I, 1)
Else
If Trouve = False Then
If Trim(Msg) <> "" Then
Cells(Cel.Row, Col) = Msg
Col = Col + 1
End If
Msg = ""
Trouve = True
Pos = I
End If
End If
Else
If Trouve = True Then
Cells(Cel.Row, Col) = CDbl(Mid(Chaine, Pos, I - Pos))
Col = Col + 1
Trouve = False
Else
Lettre = True
Msg = Msg & Mid(Chaine, I, 1)
End If
End If
Next I
If Trouve = True Then
Cells(Cel.Row, Col) = CDbl(Mid(Chaine, Pos, I - Pos))
End If
Next Cel
Columns("E:F").AutoFit
call Bouton3_Cliquer()
Sheets("???").Columns("F").COPY Sheets("???").Columns(2)
call regrouperVOSPDealerpoint_Bouton1_Cliquer()
Dim debut As Integer
nb = Sheets.Count
Set ws1 = Sheets("regrouper ??? ???")
dl1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws1.Range("A2", "BE" & dl1).ClearContents
On Error GoTo fin
debut = InputBox("Combien d'onglet voulez vous regrouper en partant de la derniere feuille ?") - 1
For I = nb To nb - debut Step -1
dl1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row + 1
Set ws = Sheets(I)
dl = ws.Cells(Rows.Count, 1).End(xlUp).Row
ws.Range("A2", "BE" & dl).COPY Destination:=ws1.Cells(dl1, 1)
Next I
MsgBox "Mise à jour effectuée"
fin:
call ???_Bouton3_Cliquer()
Dim sh, a, DernCol As Integer
Dim Wb_dest As String
Dim Wb_dep As String
Application.ScreenUpdating = False
Wb_dep = ActiveWorkbook.Name
For sh = 6 To Workbooks(Wb_dep).Sheets.Count
Ligne = 4
For a = 2 To Workbooks(Wb_dep).Sheets(sh).Range("A65536").End(xlUp).Row
If Workbooks(Wb_dep).Sheets(sh).Range("H" & a) = "1" Then
Workbooks(Wb_dep).Sheets(sh).Range("C" & a).COPY Workbooks(Wb_dep).Sheets(5).Range("C" & Ligne)
Workbooks(Wb_dep).Sheets(sh).Range("A" & a).COPY Workbooks(Wb_dep).Sheets(5).Range("D" & Ligne)
Workbooks(Wb_dep).Sheets(sh).Range("B" & a).COPY Workbooks(Wb_dep).Sheets(5).Range("E" & Ligne)
Ligne = Ligne + 1
End If
Next a
Next sh
End Sub
Voici mon message d'erreur:
Ayant un petit niveau, je bloque
Merci d'avance de votre aide