XL 2016 Aide modification macro VBA

Fabien62 · 8 Janvier 2019

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

cp4 · 9 Janvier 2019

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.

ChTi160 · 9 Janvier 2019

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

cp4 · 9 Janvier 2019

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

Bonjour @ChTi160 ,

Une variable colonne! J'avoue je n'y avais pas pensée.
Il me reste beaucoup à apprendre. Merci.

ChTi160 · 9 Janvier 2019

Re
t’inquiète cp4 moi aussi !
jean marie

Fabien62 · 9 Janvier 2019

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

Fabien62 · 10 Janvier 2019

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

ChTi160 · 10 Janvier 2019

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

Fabien62 · 10 Janvier 2019

Bonjour ChTi160,

Un fichier test est présent dans mon message d'hier à 18h53 un peu plus haut dans le fil de messages.

Merci beaucoup

Cordialement

ChTi160 · 10 Janvier 2019

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

Fabien62 · 10 Janvier 2019

Bonsoir,

Merci beaucoup Jean-Marie c'est parfait

Cdlt

XL 2016 Aide modification macro VBA

Fabien62

XLDnaute Occasionnel

cp4

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

cp4

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

Fabien62

XLDnaute Occasionnel

Pièces jointes

Fabien62

XLDnaute Occasionnel

ChTi160

XLDnaute Barbatruc

Fabien62

XLDnaute Occasionnel

ChTi160

XLDnaute Barbatruc

Fabien62

XLDnaute Occasionnel

Discussions similaires