Bonjour,
J'ai deux macros:
La premiere se trouve à l'interieur du code de la feuille "TCD"
voici le code:
La macro marche correctement.
La deuxieme se trouve dans un module standard:
voici le code:
l'objectif poursuivi avec ce deuxieme code est d'accéder directement à la feuille "Grand_Livre" sans afficher la feuille "TCD" tout en exécutant la macro 1.
Cette deuxieme macro marche à la seule condition que je sois sur la feuille "TCD" ("Feuil23" = "TCD") pour la lancer.
Dans le cas contraire la macro 1 ne s'exécute pas correctement (la colonne intitulé n'est pas renseignée).
En scrutant mon code 1,je me rends compte que la "'Création COLONNE Intitulé" ne s'est pas exécutée.
Merci de m'aider s'il vous plait.
J'ai deux macros:
La premiere se trouve à l'interieur du code de la feuille "TCD"
voici le code:
Code:
Option Explicit
Sub Rassembler()
'Feuilles à traiter
Const cF = "JAL_AN/Gestion_Créancier/Gestion_Caisse/Gestion_Banque/JAL_OD"
'Ligne des en-têtes de chaque feuille à traiter
Const cFligneDebut = "11/9/9/11/11"
'Noms des champs à copier
Const cChamps = "N°compte gle/Mois/Date/Libellé/Débit/Crédit"
'Le & remplace ' as long', le $ remplace ' as string'
Dim i&, j&, DebLig&, Finlig&, NumCol
Dim F, FligneDebut, Champs, NomF$, sh As Sheets
Dim rgTitre As Range, rgAcopier As Range, rgBase As Range, rgIci As Range
'Split transforme une chaine de caractères en un tableau de mots à une dimension
'le séparateur de mots est le caractère /
'indice inf du tableau résultant est toujours 0 (jamais 1)
F = Split(cF, "/") 'tableau des noms des feuilles à traiter
FligneDebut = Split(cFligneDebut, "/") 'Tableau des n° ligne des en-têtes
Champs = Split(cChamps, "/") 'Tableau des champs à copier
'effacer précédent traitement
Range("A2:H" & Rows.Count).Clear
Application.ScreenUpdating = False
'lbound(tablo,2) retourne le plus petit indice de la deuxième dimension de tablo
'ubound(tablo,1) retourne le plus grand indice de la première dimension de tablo
'ex: si DIM tablo( 0 to 4, 10 to 29) alors
'lbound(tablo,1)=0, ubound(tablo,1)=4, lbound(tablo,2)=10, ubound(tablo,2)=29
'si on traite la première dimension du tableau, on peut omettre ,1
'lbound(tablo)=0, ubound(tablo)=4
'Quand on ne connait pas à l'avance les bornes des indices d'un tableau, c'est pratique.
'Quand on ne sait plus si SPLIT donne des tableaux à base 0 ou 1, lbound et ubound
'permette de contourner cet oubli.
For i = LBound(F) To UBound(F)
'Boucle sur les noms de feuilles à traiter
NomF = F(i)
'ligne des en-têtes
DebLig = FligneDebut(i)
'recherche de la dernière ligne à copier
Finlig = Sheets(NomF).Range("b" & Rows.Count).End(xlUp).Row
If Finlig > DebLig Then
'il y a effectivement des données à copier
'Définir la cellule où copier les champs - on se base sur la colonne C des dates
Set rgBase = Range("c" & Rows.Count).End(xlUp).Offset(1, -2)
For j = LBound(Champs) To UBound(Champs)
'boucle sur les champs à copier
'définir la zone d'en-tête
Set rgTitre = Sheets(NomF).Range(Sheets(NomF).Cells(DebLig, "a"), Sheets(NomF).Cells(DebLig, "n"))
'on error resume next permet de continuer l'exécution si le champ cherché
'ne se trouve pas dans la ligne des titres
NumCol = 0
'rechercher le numéro de colonne du champ à copier dans la ligne d'en-têtes
On Error Resume Next
NumCol = Application.WorksheetFunction.Match(Champs(j), rgTitre, 0)
' NumCol = Application.WorksheetFunction.Match(Champs(j), rgTitre, 0)
' On Error GoTo 0 'on rétablit la détection d'erreur
If NumCol > 0 Then
'le champ a été trouvé (donc son numéro), on copie les données
Set rgAcopier = Sheets(NomF).Range(Sheets(NomF).Cells(DebLig + 1, NumCol), Sheets(NomF).Cells(Finlig, NumCol))
Set rgIci = rgBase.Offset(, j)
rgAcopier.Copy
rgIci.PasteSpecial xlPasteValues
rgIci.PasteSpecial xlPasteFormats
ElseIf NomF = "Gestion_Créancier" And Champs(j) = "Débit" Then
' le champ à copier est inconnu
'==> VERRUE 1 : feuille = "Gestion_Créancier" et Champs = "Débit"
'chercher le champ "Mtant TTC" (on suppose qu'il existe toujours)
'pas de gestion du cas où il serait inexistant!
NumCol = Application.WorksheetFunction.Match("Mtant TTC", rgTitre, 0)
Set rgAcopier = Sheets(NomF).Range(Sheets(NomF).Cells(DebLig + 1, NumCol), Sheets(NomF).Cells(Finlig, NumCol))
Set rgIci = rgBase.Offset(, j)
rgAcopier.Copy
rgIci.PasteSpecial xlPasteValues
rgIci.PasteSpecial xlPasteFormats
'chercher le champ "Dt TVA" (on suppose qu'il existe toujours)
'pas de gestion du cas où il serait inexistant!
NumCol = Application.WorksheetFunction.Match("Dt TVA", rgTitre, 0)
Set rgAcopier = Sheets(NomF).Range(Sheets(NomF).Cells(DebLig + 1, NumCol), Sheets(NomF).Cells(Finlig, NumCol))
Set rgIci = rgBase.Offset(, j)
rgAcopier.Copy
rgIci.PasteSpecial Paste:=xlPasteValues, Operation:=xlPasteSpecialOperationSubtract
ElseIf NomF = "Gestion_Créancier" And Champs(j) = "Crédit" Then
'' le champ à copier est inconnu
'==> VERRUE 2 : feuille = "Gestion_Créancier" et Champs = "Crédit"
'chercher le champ "Mtant TTC" (on suppose qu'il existe toujours)
'pas de gestion du cas où il serait inexistant!
'on ne fait rien càd on laisse la cellule à vide
Else
'le champ à recopier n'existe pas et ne fait pas l'objet d'une VERRUE
'on y met le texte en rouge <Champs> PAS TROUVÉ
Set rgIci = rgBase.Offset(, j).Resize(Finlig - DebLig)
rgIci.Value = "Champ <" & Champs(j) & "> PAS TROUVÉ"
rgIci.Font.Bold = True
rgIci.Font.Color = RGB(255, 0, 0)
End If
Next j
Set rgIci = rgBase.Offset(, j).Resize(Finlig - DebLig)
rgIci = NomF
End If
Next i
Range("a1").CurrentRegionShrinkToFit = False
Range("a1").CurrentRegion.Borders.LineStyle = xlContinuous
Range("a1").CurrentRegion.FormatConditions.Delete
Range("a1").Resize(, UBound(Champs) - LBound(Champs) + 1).Value = Champs
Range("a1").Offset(, UBound(Champs) - LBound(Champs) + 1) = "Code JAL"
'déplacement de la dernière colonne de TCD (Code JAL) avant la colonne B
Columns(UBound(Champs) - LBound(Champs) + 2).Cut
Columns("B:B").Insert Shift:=xlToRight
Range("a1").CurrentRegion.EntireColumn.AutoFit
Range("a1").CurrentRegion.Rows(1).Interior.Color = RGB(200, 200, 200)
'VERRUE: Suppression des lignes où N°compte gle est à vide
Set rgAcopier = Nothing
On Error Resume Next
Set rgAcopier = Range("a1").CurrentRegion.Offset(1).Columns(1)
Set rgAcopier = rgAcopier.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not rgAcopier Is Nothing Then
'il y a des cellules vide, on supprime leur ligne
rgAcopier.EntireRow.Delete
End If
'Création COLONNE Intitulé
Range("H1") = "Intitulé"
Range("H2").Select
ActiveCell.FormulaR1C1 = "=IF(ISBLANK(RC[-7]),"""",CONCATENATE(RC[-7],"" - "",(LOOKUP(RC[-7],COMPTES,INTITULE_COMPTES))))"
Selection.Copy
Range("H3:H" & ActiveSheet.UsedRange.Rows.Count).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("H1").CurrentRegion.EntireColumn.AutoFit
'RANGER par N° de compte du plus petit au plus grand
Range("A1:H1").Select
Selection.AutoFilter
ActiveWorkbook.Worksheets("TCD").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("TCD").AutoFilter.Sort.SortFields.Add Key:=Range( _
"A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("TCD").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1:H1").Select
Selection.AutoFilter
Range("a1").Select
Application.ScreenUpdating = True
End SubLa macro marche correctement.
La deuxieme se trouve dans un module standard:
voici le code:
Code:
Sub ActualiserGrdLivre()
'
' ActualiserGrdLivre Macro
'
' Touche de raccourci du clavier: Ctrl+g
'
On Error Resume Next
Application.ScreenUpdating = False
Application.Run "Feuil23.Rassembler"
Sheets("Grand_Livre").Select
Range("A9").Select
ActiveSheet.PivotTables("Grand Livre des comptes").PivotCache.Refresh
End Subl'objectif poursuivi avec ce deuxieme code est d'accéder directement à la feuille "Grand_Livre" sans afficher la feuille "TCD" tout en exécutant la macro 1.
Cette deuxieme macro marche à la seule condition que je sois sur la feuille "TCD" ("Feuil23" = "TCD") pour la lancer.
Dans le cas contraire la macro 1 ne s'exécute pas correctement (la colonne intitulé n'est pas renseignée).
En scrutant mon code 1,je me rends compte que la "'Création COLONNE Intitulé" ne s'est pas exécutée.
Merci de m'aider s'il vous plait.
