XL 2016 Aide modification macro VBA

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
 

cp4

XLDnaute Accro
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

XLDnaute Barbatruc
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

XLDnaute Accro
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.
 

Fabien62

XLDnaute Occasionnel
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

  • Planning Charge 2018 v3 Test.xlsm
    349.4 KB · Affichages: 18
Dernière édition:

Fabien62

XLDnaute Occasionnel
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

XLDnaute Barbatruc
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
 

ChTi160

XLDnaute Barbatruc
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
 

Discussions similaires

Réponses
2
Affichages
190

Statistiques des forums

Discussions
292 869
Messages
1 926 872
Membres
183 293
dernier inscrit
GMS