XL 2016 Aide modification macro VBA

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion Fabien62
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
Fabien62

Fabien62

XLDnaute Occasionnel
Bonjour le forum,

Voici une macro qui est utilisée dans l'un de mes fichiers et je cherche à la modifier :

VB: 
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim deb As Date, fin As Date, t1, t2, tablo, I&, n&, Ws As Worksheet
With Sh
  If .Name Like "Taxe*" Then 'critère
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual 'calcul manuel
    deb = DateSerial([An], .[G5], 1)
    fin = DateSerial([An], .[H5] + 1, 1)
    .Rows.Hidden = False 'RAZ
    .[A10:C72,H10:H72] = "" 'RAZ
    t1 = .[A10:C72]: t2 = [H10:H72]
    For Each Ws In Sheets(Array(Feuil1.Name, Feuil10.Name))
    tablo = Ws.[A1].CurrentRegion.Resize(, 27) 'matrice, plus rapide
    For I = 2 To UBound(tablo)
      If tablo(I, 2) >= deb And tablo(I, 2) < fin And tablo(I, 12) = "Convention" Then
        n = n + 1
        If n < 64 Then 'sécurité
          t1(n, 1) = tablo(I, 2): t1(n, 2) = tablo(I, 3)
          t1(n, 3) = tablo(I, 27): t2(n, 1) = tablo(I, 10)
        End If
      End If
    Next
    Next
    .[A10:C72] = t1: .[H10:H72] = t2
    .[A10:H72].Sort .[A10], xlAscending, Header:=xlNo 'tri
    If n < 63 Then .Rows(n + 10 & ":72").Hidden = True 'Total en ligne 73
    Application.Calculation = xlCalculationAutomatic
  End If
End With
End Sub

Au départ, la feuille 1 et 10 utilisaient la même colonne de référence à savoir la 27, or, j'ai dû apporter des modifications à la feuille 10, ce qui fait que la référence a bougée et est devenue 40, ce qui donnerait la ligne VBA :

VB: 
  tablo = Ws.[A1].CurrentRegion.Resize(, 40) 'matrice, plus rapide

A l'heure actuelle, la macro ne fonctionne plus que sur la feuille 1, je cherche à modifier pour qu'elle fonctionne sur les deux feuilles ayant deux références différentes.

Si nécessaire je mettrais un fichier test en ligne que je dois préparer.

Je vous remercie pour votre aide

Cordialement
 
Trier par date Trier par votes
Bonjour,

Tu utilises le module ce code Workbook_SheetActivate. Or, là tu as modifié les références de la feuille 10, je pense qu'il faudrait utiliser pour chacune des feuilles 1 et 10 l'évènement Worksheet_Activate. c-à-d chaque feuille aura son propre code.

Bonne journée.
 
Vote positif 0 Vote négatif
Bojour
Bonjour le Fil(cp4), le Forum
peut être en utilisant une variable Colonne
VB: 
'en tete de module Dim deb As Date, fin As Date, t1, t2, tablo, I&, n&, Ws As Worksheet ,Col as byte
For Each Ws In Sheets(Array(Feuil1.Name, Feuil10.Name))
    Col = IIf(Ws.Name = Feuil1.Name, 27, 40)
    tablo = Ws.[A1].CurrentRegion.Resize(, Col) 'matrice, plus rapide
non testé!
jean marie
 
Vote positif 0 Vote négatif
ChTi160 à dit:
Bojour
Bonjour le Fil(cp4), le Forum
peut être en utilisant une variable Colonne
VB: 
'en tete de module Dim deb As Date, fin As Date, t1, t2, tablo, I&, n&, Ws As Worksheet ,Col as byte
For Each Ws In Sheets(Array(Feuil1.Name, Feuil10.Name))
    Col = IIf(Ws.Name = Feuil1.Name, 27, 40)
    tablo = Ws.[A1].CurrentRegion.Resize(, Col) 'matrice, plus rapide
non testé!
jean marie
Cliquez pour agrandir...
Bonjour @ChTi160 😉,

Une variable colonne! J'avoue je n'y avais pas pensée.
Il me reste beaucoup à apprendre. Merci.
 
Vote positif 0 Vote négatif
Bonsoir ChTi160 et Cp4, le Forum,

Merci pour votre participation et votre solution proposée que je vais tester.

Voici le fichier pour essai si vous voulez essayer de votre côté également

Petite erreur de ma part, la nouvelle réf de colonne est 43 et non 40

Merci beaucoup

Cordialement
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Bonjour,

J'ai testé la macro, je pense avoir fais une erreur car j'ai une erreur d'exécution 9

Voici comment j'ai intégré votre solution :

VB: 
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim deb As Date, fin As Date, t1, t2, tablo, I&, n&, Ws As Worksheet, Col As Byte
With Sh
  If .Name Like "Taxe*" Then 'critère
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual 'calcul manuel
    deb = DateSerial([An], .[G5], 1)
    fin = DateSerial([An], .[H5] + 1, 1)
    .Rows.Hidden = False 'RAZ
    .[A10:C72,H10:H72] = "" 'RAZ
    t1 = .[A10:C72]: t2 = [H10:H72]
    For Each Ws In Sheets(Array(Feuil1.Name, Feuil10.Name))
    Col = IIf(Ws.Name = Feuil1.Name, 27, 43)
    tablo = Ws.[A1].CurrentRegion.Resize(, Col) 'matrice, plus rapide
    For I = 2 To UBound(tablo)
      If tablo(I, 2) >= deb And tablo(I, 2) < fin And tablo(I, 12) = "Convention" Then
        n = n + 1
        If n < 64 Then 'sécurité
          t1(n, 1) = tablo(I, 2): t1(n, 2) = tablo(I, 3)
          t1(n, 3) = tablo(I, 43): t2(n, 1) = tablo(I, 10)
        End If
      End If
    Next
    Next
    .[A10:C72] = t1: .[H10:H72] = t2
    .[A10:H72].Sort .[A10], xlAscending, Header:=xlNo 'tri
    If n < 63 Then .Rows(n + 10 & ":72").Hidden = True 'Total en ligne 73
    Application.Calculation = xlCalculationAutomatic
  End If
End With
End Sub

Cordialement
 
Vote positif 0 Vote négatif
Bonjour Fabien62
Bonjour le Fil ,le Forum
VB: 
If n < 64 Then 'sécurité
          t1(n, 1) = tablo(I, 2): t1(n, 2) = tablo(I, 3)
          t1(n, 3) = tablo(I, 43): t2(n, 1) = tablo(I, 10)
End If
je vois que dans cette partie du code , il y apparaît "43" ça peut poser problème si traitement de feuil1.name(27)
mais sans fichier difficile de tester.
jean marie
 
Vote positif 0 Vote négatif
Re
la procédure modifiée qui semble fonctionner!
VB: 
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim deb As Date, fin As Date, t1, t2, tablo, I&, n&, Ws As Worksheet
 Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual 'calcul manuel
With Sh
  If .Name Like "Taxe*" Then 'critère   
    deb = DateSerial([An], .[G5], 1)
    fin = DateSerial([An], .[H5] + 1, 1)
    .Rows.Hidden = False 'RAZ
    .[A10:C72,H10:H72] = "" 'RAZ
    t1 = .[A10:C72]: t2 = [H10:H72]
    For Each Ws In Sheets(Array(Feuil1.Name, Feuil10.Name))
     col = IIf(Ws.Name = Feuil1.Name, 27, 43)
    tablo = Ws.[A1].CurrentRegion.Resize(, col) 'matrice, plus rapide
    For I = 2 To UBound(tablo)
      If tablo(I, 2) >= deb And tablo(I, 2) < fin And tablo(I, 12) = "Convention" Then
        n = n + 1
        If n < 64 Then 'sécurité
          t1(n, 1) = tablo(I, 2): t1(n, 2) = tablo(I, 3)
          t1(n, 3) = tablo(I, col): t2(n, 1) = tablo(I, 10)
        End If
      End If
    Next
    Next
    .[A10:C72] = t1: .[H10:H72] = t2
    .[A10:H72].Sort .[A10], xlAscending, Header:=xlNo 'tri
    If n < 63 Then .Rows(n + 10 & ":72").Hidden = True 'Total en ligne 73
  End If
End With
   Application.Calculation = xlCalculationAutomatic
End Sub
jean marie
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

G
  • Résolu(e)
XL 2016 Pb de tri et sous totaux
2
Réponses
27
Affichages
337
Gestionnaire_rh
G
cathodique
  • Question Question
XL 2010 Code de l'IA à corriger
2 3
Réponses
33
Affichages
2 K
cathodique
cathodique
patricktoulon
  • Question Question
Autres la fonction similaire
Réponses
11
Affichages
487
patricktoulon
patricktoulon
K
  • Résolu(e)
XL 2016 Affichage TextBox
Réponses
6
Affichages
100
KRUG WOO
K
G
  • Question Question
XL 2021 Macro pour changer les titres de fichier d'archive
Réponses
3
Affichages
99
fanch55
fanch55
C
  • Résolu(e)
XL 2021 Macro pour mise en page
Réponses
11
Affichages
572
candido57
C
M
  • Question Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
413
marie3107
M
piga25
  • Résolu(e)
XL 2016 En VBA, Automatiser la réponse en fonction de l'état d'une cellule.
Réponses
7
Affichages
82
piga25
piga25
M
  • Question Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
646
marie3107
M
T
  • Résolu(e)
XL 2016 macro et feuille protégé
2
Réponses
18
Affichages
738
laurent950
laurent950
C
  • Résolu(e)
XL 2016 Répartir dans des Groupes d'Effectifs Aléatoires ... mais pas trop
Réponses
2
Affichages
373
crocrocro
C
A
  • Question Question
Insérer un copier / coller
Réponses
0
Affichages
322
aziz
A
C
  • Résolu(e)
Microsoft 365 Amélioration Macro.
Réponses
7
Affichages
548
crazy
C
J
  • Question Question
Microsoft 365 Probléme VBA
Réponses
8
Affichages
234
jalaba
J
A
  • Question Question
VBA qui fonctionnait avant, mais ne fonctionne plus avec le 64 bits
Réponses
2
Affichages
222
patricktoulon
patricktoulon
L
  • Question Question
XL 2019 Excel - utilisation des unbound pour grande base de donnees
Réponses
11
Affichages
857
Lordpeter
L
M
  • Résolu(e)
XL 2021 PUBLIPOSTAGE : Mise en forme du corps de message issu d'une cellule excel (VBA)
Réponses
4
Affichages
465
Minus&Cortex
M
Nicolas JACQUIN
  • Question Question
XL 2019 Fusionner jusqu'à dernière colonne contenant
Réponses
8
Affichages
704
TooFatBoy
TooFatBoy
L
  • Question Question
VBA : erreur sur boucle
Réponses
2
Affichages
303
Latias
L
M
  • Question Question
XL 2013 MACRO VBA pour imprimer tous les bulletins d'un établissement scolaire
Réponses
4
Affichages
308
MBEPID
M
Retour