XL 2016 Aide modification macro VBA

[Fabien62]

Bonjour le forum,

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

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 :

  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]

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]

Bojour
Bonjour le Fil(cp4), le Forum
peut être en utilisant une variable Colonne

'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]

Bojour
Bonjour le Fil(cp4), le Forum
peut être en utilisant une variable Colonne

'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]

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

 

[Fabien62]

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]

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 :

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]

Bonjour Fabien62
Bonjour le Fil ,le Forum

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]

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]

Re
la procédure modifiée qui semble fonctionner!

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]

Bonsoir,

Merci beaucoup Jean-Marie c'est parfait

Cdlt