Code erreur pour le regroupement de plusieurs macro

JoeZ1

XLDnaute Nouveau
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:D1000" & 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:

upload_2018-9-5_13-56-36.png



Ayant un petit niveau, je bloque

Merci d'avance de votre aide
 

JoeZ1

XLDnaute Nouveau
Je vais essayer d'expliquer le fonctionnement du fichier:

Les onglets Info dp et info vo se sont des donnees d'autres fichiers, c'est ma base de travail

le deroulement de fontionnement:
Onglet"info dp" -> bouton extract dp
Onglet"info vo" -> bouton Extract vo

Onglet "vo" -> bouton Decomposer puis bouton copier coller
Onglet "regrouper vo dp" -> bouton extract vo dp tapez 2
Onglet "Extract TM" -> bouton extract

Et tout fonctionne

Bouton9, c'est le bouton où je souhaite tout regrouper en une seule macro et qui ne fonctionne pas :(
 

Pièces jointes

  • Extract check TMtest.xlsm
    100.8 KB · Affichages: 22

vgendron

XLDnaute Barbatruc
puisque toutes tes macros fonctionnent séparémment
pourquoi ne pas simplement les appeler chacune leur tour..
VB:
Sub Bouton9_Cliquer()

Call infodealerpoint_Bouton1_Cliquer
Call infoVOSP_Bouton1_Cliquer
Call Bouton2_Cliquer
Call Bouton3_Cliquer
Call regrouperVOSPDealerpoint_Bouton1_Cliquer
Call ExtractTM_Bouton3_Cliquer

End Sub

après.. si c'est pour de l'optimisation de code.. effectivement.. il y a plusieurs pistes..
exemple: la macro du bouton "Extract Dp"
si j'ai bien compris.. elle copie les colonnes F G et C si il y a "N "en colonne D
plutot que de scruter les lignes une par une. tu peux utiliser le filtre sur la colonne D et copier coller juste les lignes filtrées..
question pour cette macro: la feuille InfoDp peut apparaitre plusieurs fois dans le classeur??
parce que tu fais une boucle sur TOUTES les feuilles du classeur.. (dans le classeur exemple fourni, il n'y a QUe la feuille "InfoDp" qui semble concernée..
 

vgendron

XLDnaute Barbatruc
exemples de macro "optimisées"

VB:
Sub ExtractInfoDealerPoint()
'extrait les lignes "N" de la feuille "info dp" vers la feuille "dp"
With Sheets("dp")
    .UsedRange.Offset(1, 0).ClearContents
End With

With Sheets("info dp")
    .UsedRange.AutoFilter Field:=4, Criteria1:="N"
    .UsedRange.SpecialCells(xlCellTypeVisible).Offset(1, 0).Columns(6).Copy Destination:=Sheets("dp").Range("A65536").End(xlUp).Offset(1, 0)
    .UsedRange.SpecialCells(xlCellTypeVisible).Offset(1, 0).Columns(7).Copy Destination:=Sheets("dp").Range("B65536").End(xlUp).Offset(1, 0)
    .UsedRange.SpecialCells(xlCellTypeVisible).Offset(1, 0).Columns(3).Copy Destination:=Sheets("dp").Range("C65536").End(xlUp).Offset(1, 0)
    .UsedRange.AutoFilter
End With
End Sub
Sub ExtractInfoVOSP()
'extrait les lignes "YES" de la feuille "info vo" vers la feuille "vo"

With Sheets("vo")
    .UsedRange.Offset(1, 0).ClearContents
End With

With Sheets("info VO")
    .UsedRange.AutoFilter Field:=1, Criteria1:="YES"
    .UsedRange.SpecialCells(xlCellTypeVisible).Offset(1, 0).Columns(3).Copy Destination:=Sheets("vo").Range("A65536").End(xlUp).Offset(1, 0)
    .UsedRange.SpecialCells(xlCellTypeVisible).Offset(1, 0).Columns(4).Copy Destination:=Sheets("vo").Range("D65536").End(xlUp).Offset(1, 0)
    .UsedRange.SpecialCells(xlCellTypeVisible).Offset(1, 0).Columns(8).Copy Destination:=Sheets("vo").Range("C65536").End(xlUp).Offset(1, 0)
    .UsedRange.AutoFilter
End With
End Sub
 

JoeZ1

XLDnaute Nouveau
Sub ExtractInfoVOSP()
'extrait les lignes "YES" de la feuille "info vo" vers la feuille "vo"

With Sheets("vo")
.UsedRange.Offset(1, 0).ClearContents
End With

With Sheets("info VO")
.UsedRange.AutoFilter Field:=1, Criteria1:="YES"
.UsedRange.SpecialCells(xlCellTypeVisible).Offset(1, 0).Columns(3).Copy Destination:=Sheets("vo").Range("A65536").End(xlUp).Offset(1, 0)
.UsedRange.SpecialCells(xlCellTypeVisible).Offset(1, 0).Columns(4).Copy Destination:=Sheets("vo").Range("D65536").End(xlUp).Offset(1, 0)
.UsedRange.SpecialCells(xlCellTypeVisible).Offset(1, 0).Columns(8).Copy Destination:=Sheets("vo").Range("C65536").End(xlUp).Offset(1, 0)
.UsedRange.AutoFilter
End With
End
Sub
Bonjour ,

Top.l'optimisation

Mais la macro ci dessus, il ne se passe rien. Bizarrement
Et pourtant, elle est identique à l'autre qui fonctionne tres bien
 

vgendron

XLDnaute Barbatruc
Mais la macro ci dessus, il ne se passe rien
en es tu bien sur??
1) as tu bien vu que j'avais changé le nom de la macro.. donc. sans autre changement, ton bouton continue à appeler ta macro initiale
2) execute la en mode pas à pas avec la touche F8
l'utilisation des with permet de ne pas avoir à selectionner la feuille concernée. donc .. en mode pas à pas. si tu ne l'active pas toi meme entre deux lignes de code. tu ne verra pas les actions
la macro commence par effacer la feuille destination (dp ou vo)
ensuite active un filtre sur la feuille origine (N sur db ou Yes sur vo) et copie colle le résultat..

Comme tout se passe très vite.. c'est peut etre pour ca que tu ne vois rien...? :-D
 

vgendron

XLDnaute Barbatruc
je suis en train de regarder le reste de ton code, j'ai quelques idées de "simplification"
mais quelques questions avant:

1) lors de l'extraction de "info dp" vers "dp"
peut il y avoir plusieurs feuilles à traiter et à exporter vers dp? (tu as fait une boucle sur toutes les feuilles du classeur)
si oui: ont elles un nom particulier? (genre "info dp1 " - "info dp2" - "info dp...." ?
2) lors de l'extraction de "info VO" vers "vo"
memes questions

3) dans la feuille "vo"
lorsque tu décomposes la colonne D vers colonnes E et F
en colonne D: c'est TOUJOURS un lettre Puis un nombre?
ou alors ca peut etre un mélange de lettres et chiffres et caractères (, - +) que tu souhaites séparer?
je ne comprends pas bien la logique du code: s'il s'agit "juste" de récuperer le premier caractère en colonne E et le reste en F, ca me semble compliqué
==> il faudrait que tu mettes quelques lignes avec différents cas de figure qui peuvent arriver

4) dans la macro "regrouperVOSPDealerpoint_Bouton1_Cliquer()"
tu demandes le nombre d'onglet à partir du dernier à regrouper..
si on met 3: comment les onglets sont ils censés s'appeler? vo - dp et???
 

JoeZ1

XLDnaute Nouveau
Concernant les questions 1-2: Non, c'est direct de Info dp ou info vo vers dp ou vo
Question 3: Oui c'est toujours 1 lettres et 6 chiffres et j'ai besoin de recuperer que les chiffres
Question 4: C'est par moment j'ai besoin de travailler qu'avec vo et d'autres moment avec les 2. Jamais dp seul
Et normalement, il ne devrait pas d'autres onglets
 

JoeZ1

XLDnaute Nouveau
en es tu bien sur??
1) as tu bien vu que j'avais changé le nom de la macro.. donc. sans autre changement, ton bouton continue à appeler ta macro initiale
2) execute la en mode pas à pas avec la touche F8
l'utilisation des with permet de ne pas avoir à selectionner la feuille concernée. donc .. en mode pas à pas. si tu ne l'active pas toi meme entre deux lignes de code. tu ne verra pas les actions
la macro commence par effacer la feuille destination (dp ou vo)
ensuite active un filtre sur la feuille origine (N sur db ou Yes sur vo) et copie colle le résultat..

Comme tout se passe très vite.. c'est peut etre pour ca que tu ne vois rien...? :-D
Je viens de regarder ton explication. Mais je n'arrive pas à la faire fonctionner.
Il y a une etape qui m'echappe
Je remets le fichier modifier avec tes macros
 

Pièces jointes

  • Extract check TMtest.xlsm
    98.8 KB · Affichages: 21

vgendron

XLDnaute Barbatruc
ah oui.. pardon.. j'avais zappé..
c'est le "liste alerte" en cellule A1 de la feuille "info VO" qui gène..
je l'avais supprimé avant de lancer la macro

si on le laisse. le filtre automatique se met sur la ligne 1.. et du coup. la zone de filtre ne s'étend pas jusqu'en bas de la feuille..
et donc. rien à filter.. donc rien à copier..
 

vgendron

XLDnaute Barbatruc
En PJ une version "optimisée" macro par macro

toutes les macros utilisées sont dans un seul module
je te laisse aller voir le code avec les quelques commentaires

pour la dernière macro.. elle n'est censée travailler QUE sur la feuille "Regrouper Vo DP" ?
sauf qu'elle regarde si la colonne H est vide. (ce qui est toujours le cas dans l'exemple)..??
 

Pièces jointes

  • Extract check TMtest Optimisé Bis.xlsm
    71 KB · Affichages: 23

Discussions similaires

Réponses
5
Affichages
275
  • Question
Microsoft 365 Code VBA
Réponses
10
Affichages
704

Statistiques des forums

Discussions
314 644
Messages
2 111 528
Membres
111 189
dernier inscrit
Laurent.