[Resolu]Retraiter des bases, les réunir et faire un TCD

yoldas · 6 Juin 2012

Bonjour à tous,

Je viens vous solliciter car je n'ai que trop peu de connaissances en VBA pour atteindre mon but sur ce coup

Alors je vous explique mon cas.

Je souhaite créer un fichier unique dans lequel les utilisateurs viendraient rajouter leur fichier extrait du logiciel pour en obtenir une synthèse. Il s'agit d'information à caractère comptable (rémunération d'une catégorie de notre personnel).

Dans le fichier joint, vous pourrez voir que le fichier comporte déjà plusieurs onglets pour des raisons propres à la gestion de projets en cours.

En tout état de cause, voici donc comment ce fichier devra être utilisé.

L'utilisateur récupère son extraction, l'insère dans mon fichier et renomme l'onglet selon l'année en cours.
Mon fichier compte donc déjà des onglets 2008, 2009, 2010, 2011 et 2012.
Pour les MàJ de l'année en cours, il supprime l'onget -mettons 2012- à mettre à jour, et le remplace par son extraction.

Une fois ces manips inévitables effectuées, j'aimerai qu'une macro se lance et exécute les étapes suivantes :

1-Insérer une colonne en A:A et remplir les cellules de l'année qui concerne l'onglet.
Limites constatées :
- à cause des cellules fusionnées en première ligne, le bout de code VBA que j'avais construit n'insère pas une mais plusieurs colonnes ;
- une fois les onglets des années précédentes à l'année en cours retraitées, plus besoin d'y revenir ;
- le nombre de ligne d'une année (d'un onglet) à l'autre est différent, donc la macro devra tester le contenu de la cellule Mois avant de remplir la première colonne
- à chaque MàJ, donc à chaque nouvelle insertion d'onglet 2012, 2013, etc...(tout au long du cycle de vie de ce fichier), la macro ne devra s'exécuter que sur l'onglet le plus récent.

Une fois ce retraitement effectué, il faudrait récupérer le contenu de tous les onglets, sauf le titre et aller le recopier dans l'onglet Journal_PNP.

Pour finir, faire un TCD avec les codes analytiques en ligne, et une première colonne qui correspondrait à l'année la plus récente, et une seconde au cumul de toutes les années restantes. Données sommées, la masse salariale.

Enfin, copier/collage spécial du contenu de ce TCD en valeur pour pouvoir réutiliser ces données dans le cadre d'une recherchev dans un autre tableau. Tout cela dans l'onglet synthèse. Le TCD à la poubelle une fois qu'on a les valeurs.

Pour résumé, pour ceux qui m'ont lu jusqu'au bout :
1-consolider des informations de même nature issues de plusieurs années de gestion ;
2-en faire un TCD avec les données de l'année en cours et celles des années passées (cumulées) ;
3-n'en garder que les valeurs.

Merci à vous,
Mes amitiés

Bebere · 6 Juin 2012

Re : Retraiter des bases, les réunir et faire un TCD

bonjour Yoldas
bienvenue
code dans module1
tu peux exécuter le code, les données des feuilles synthèse et journal sont effacées
tu as un code à exécuter après ajout d'une feuille
ensuite exécuter synthese
à bientôt

yoldas · 7 Juin 2012

Re : Retraiter des bases, les réunir et faire un TCD

Bonjour Bebere,

Merci pour le petit mot de bienvenu et pour le travail effectué sur mon fichier.
Je viens de regarder et j'aurai été bien incapable de faire aussi bien ! D'ailleurs, j'aimerai bien apprendre à faire par moi-même...si des fois vous auriez une méthode miracle, je veux bien m'y mettre de suite

J'adore Excel, et ai lu les documents d'initiation au vba mais m'y suis arrêté là pour l'instant..

Je reviendrai sur cette file ce soir, car j'ai peut-être été trop prompte à venir vous solliciter. Après réflexion sur l'utilisation du fichier hier soir, je me suis rendu compte qu'il aurait peut être fallu faire encore autrement. En effet, j'ai remarqué d'autres limites si je souhaite qu'il soit utilisé d'une certaine manière.

Je repasse donc ce soir.
J'espère que tout le travail fourni ne sera pas perdu et que je/nous pourrais/pourrons réutiliser une partie du code.

Encore mille merci, bonne journée.
Cdt
Yoldas

yoldas · 7 Juin 2012

Re : Retraiter des bases, les réunir et faire un TCD

Re bonsoir à tous,

J'essaie un peu plus d'écrire sous l'éditeur (et non plus lancer l'enregistrement bouhh), et je prends beaucoup de plaisir à écrire mes bouts de code tout seul. J'avoue que je suis quand même encore obligé de m'inspirer de la logique de choses qu'ont fait d'autres avant moi, mais j'ose espérer que bientôt je me débrouillerai tout seul =)

J'aurai besoin d'un coup de pouce sur un truc pour lequel je ne trouve aucune aide.

Voilà, je souhaite copier/coller le contenu de toutes les feuilles, sans les entêtes, dans la feuille journal_PNP, avec pour coin supérieur gauche la cellule B2.
Puis, en colonne A, je souhaite lancer une fonction "année" sur la colonne "mois". Donc il faudrait tester la colonne G où apparaît le nom, car je suis sur que cette colonne comporte toujours une donnée. Dès que Columns("AB") = "" stop de remplir Columns("A").

lol, même ça je connaissais pas avant de lire le cours =)

Petite difficulté évidemment, j'ai pas le même nombre de lignes d'année en année. Logique

Enfin, voilà vous avez compris l'idée je pense.

Je vous remercie de m'avoir lu, et encore plus ceux qui pourront me donner un p'tit coup de pouce.

A bientôt,
Yoldas

yoldas · 9 Juin 2012

Re : Retraiter des bases, les réunir et faire un TCD

Je passe le sujet a resolu puisque j'ai tous les elements dans le code ecrit par bebere pour reussir ce que je souhaite faire

Encore merci
Mes amities

yoldas · 10 Juin 2012

Re : [Besoin encore d'un peu d'aide]Retraiter des bases, les réunir et faire un TCD

Voilà 1h30 du mat', j'ai presque fini mon fichier

Je bloque encore sur un ou deux trucs, et je ne sais vraiment pas comment faire. Si une âme charitable voulait bien me donner un p'tit coup de pouce, ce ne serait pas de trop..
J'ai mis en rouge les points qui posent problème.

Je n'ai pas joins le fichier car j'ai bossé sur le fichier avec les données originales et j'ai pas le courage à cette heure-ci de reprendre le contenu du fichier pour le rendre confidentiel.

Merci à vous tous pour le temps que vous passerez à m'aider,
Mes amitiés Forum =)

EDIT : SI A LA LECTURE DE MON CODE, VOUS TROUVEZ DES CHOSES A AMELIORER, NE VOUS GENEZ PAS POUR ME LE FAIRE SAVOIR. C'EST LA PREMIERE FOIS QUE J'ALIGNE PLUS DE 3 LIGNES EN VBA

Sub maj_pnp()

'Déclaration de la variable
Dim Ws As Worksheet

'Cache le message de suppression de feuille & supprime la feuille nommée Journal_PNP si elle existe
Application.DisplayAlerts = False
For Each Ws In ActiveWorkbook.Worksheets
If Ws.Name = "Journal_PNP" Then
Ws.Delete
Exit For
End If
Next

'Rend visible le message de suppression de feuille
Application.DisplayAlerts = True

'Crée une feuille Journal_PNP
Sheets.Add
ActiveSheet.Name = "Journal_PNP"

'Nomme les entêtes de la feuille Journal_PNP
Range("A1") = "Année"
Range("B1") = "Matricule"
Range("C1") = "Budget"
Range("D1") = "Code analytique"
Range("E1") = "Acronyme"
Range("F1") = "Département"
Range("G1") = "Sexe"
Range("H1") = "Nom"
Range("I1") = "Prénom"
Range("J1") = "Nationalité"
Range("K1") = "Encadrant"
Range("L1") = "Type de contrat"
Range("M1") = "Catégorie"
Range("N1") = "Intitulé de poste"
Range("O1") = "Date d'entrée"
Range("P1") = "Date de sortie"
Range("Q1") = "Salaire brut/Bourse EGIDE"
Range("R1") = "Transport/Complément EGIDE"
Range("S1") = "Ch.patr./Frais de gest.TTC"
Range("T1") = "Prov.chômage"
Range("U1") = "Ma.sal.charg transport/EGIDE TTC"
Range("V1") = "Msc transp sans prov. chômage"
Range("W1") = "EGIDE HTR"
Range("X1") = "Cumul EGIDE HTR"
Range("Y1") = "TVA EGIDE non récupérable"
Range("Z1") = "Cumul msc transport code ana"
Range("AA1") = "Cumul msc transport poste"
Range("AB1") = "Cumul msc transport personne"
Range("AC1") = "Mois"
Range("AD1") = "ETPV"
Range("AE1") = "ETPTV"
Range("AF1") = "Type de contrat"
Range("AG1") = "Quotité du temps"
Range("AH1") = "Historique des statuts"
Range("AI1") = "Financement"

Range("A1:AI1").Select
Range("A1:AI1").Font.Bold = True
Range("A1:AI1").Font.Size = 8
Range("A1:AI1").Font.Name = "Arial"
Range("A1:AI1").Interior.Color = RGB(153, 204, 0)

'Fige la première ligne et se positionne au niveau de la cellule A2
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Range("A2").Select

'Recopie le contenu de tous les onglets autre que Journal_PNP dans Journal_PNP
'Se positionne à la première ligne vide de l'onglet Journal_PNP pour copier le contenu des autres onglets
'Ramène l'année indiquée sur l'onglet en première colonne de l'onglet Journal_PNP (i)

'FAIRE DIFFEREMMENT CAR LES ONGLETS A VENIR NE SERONT PAS PRIS EN COMPTE
IL FAUDRAIT PRENDRE TOUS LES ONGLETS SAUF JOURNAL_PNP ET NON PAS I = 2008 to 2012

For i = 2008 To 2012
With Worksheets("Journal_PNP")
ld = .Range("H65536").End(xlUp).Row + 1
End With

'QUE SIGNIFIE Cstr(i)
ICI PAREIL, MEME REMARQUE QUE POUR LES ONGLETS A PRENDRE EN COMPTE cf. i

With Worksheets(CStr(i))
derl = .Range("A65536:AH65536").End(xlUp).Row
.Range("A3:AH" & derl).Copy Destination:=Worksheets("Journal_PNP").Range("B" & ld)
lf = Worksheets("Journal_PNP").Range("B65536").End(xlUp).Row
Worksheets("Journal_PNP").Range("A" & ld & ":A" & lf).Value = i
End With
Next i

'Suppression de l'onglet Synthèse
Application.DisplayAlerts = False
For Each Ws In ActiveWorkbook.Worksheets
If Ws.Name = "Synthèse" Then
Ws.Delete
Exit For
End If
Next

'Rend visible le message de suppression de feuille
Application.DisplayAlerts = True

'Création de l'onglet Synthèse et formatage
'DIFFERENCIER LA DERNIERE ANNEE (CELLE EN COURS) ET LES AUTRES, COMPARER LES NOMS D'ONGLETS ENTRE EUX POUR PRENDRE LE PLUS RECENT D'UN COTE ET TOUS LES AUTRES D'UN AUTRE

Sheets.Add
ActiveSheet.Name = "Synthèse"
Range("A1") = "Code analytique"
Range("B1") = "Acronyme"
Range("C1") = "2012" 'ICI MEME PROBLEMATIQUE
Range("D1") = "Avant 2012" 'ICI MEME PROBLEMATIQUE

Range("A11").Select
Range("A11").Font.Bold = True
Range("A11").Font.Size = 8
Range("A11").Font.Name = "Arial"

Range("A11").Interior.Color = RGB(153, 204, 0)

'Journal_PNP vers synthèse
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
With Worksheets("Journal_PNP")
derl = .Range("A65536:AH65536").End(xlUp).Row
For l = 2 To derl

'Code analytique sans doublon
d(.Cells(l, 4).Value) = .Cells(l, 4).Value
Next
.Range("D2" & derl).Name = "ColD"
.Range("U2:U" & derl).Name = "ColU"

End With

With Worksheets("Synthèse")
l = 2
For Each Item In d.items
.Range("A" & l).Value = Item
l = l + 1
Next
derl = .Range("A65536").End(xlUp).Row

For l = 2 To derl

'Somme par code
FAIRE SOMME.SI AVEC DEUX CONDITIONS LE CODE ANALYTIQUE MAIS AUSSI L'ANNEE
L'ANNEE EN COLONNE A ET LE CODE ANALYTIQUE EN COLONNE D

.Range("D" & l).Value = Application.WorksheetFunction.SumIf(Range("ColD"), .Range("A" & l),
Range("ColU"))
Next
End With
Application.ScreenUpdating = True

'Fige la première ligne et se positionne au niveau de la cellule A2
Rows("2:2").Select
ActiveWindow.FreezePanes = True

'RechercheV sur le code analytique pour ramener l'intitulé depuis l'onglet Journal_PNP
Range("B2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Journal_PNP!C[2]:C[3],2,FALSE)"
Selection.AutoFill Destination:=Range("B2:B" & derl)

'Centre les titres et ajuste la taille des colonnes A à D au contenu
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("A").EntireColumn.AutoFit

'Dessine des bordures au tableau
Range("A1" & derl).Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
ActiveWindow.SmallScroll Down:=-12
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("A2").Select

'Format comptable sans unité de mesure et sans décimale et remplace les cases vides par des 0
Range("C2" & derl).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
Selection.Replace What:="", Replacement:="0", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

'Se positionne celulle A2
Range("A2").Select

' Enregisrer le classeur actif
ActiveWorkbook.Save

End Sub

JCGL · 10 Juin 2012

Re : [Besoin encore d'un peu d'aide]Retraiter des bases, les réunir et faire un TCD

Bonjour à tous,

Peux-tu essayer ceci :

VB:

Option Explicit


Sub maj_pnp()
    Dim Ws As Worksheet
    Dim i%, ld%, DerL%, lf%, l%
    Dim d As Object
    Dim Item


    Application.DisplayAlerts = False
    For Each Ws In ActiveWorkbook.Worksheets
        If Ws.Name = "Journal_PNP" Then
            Ws.Delete
            Exit For
        End If
    Next
    Application.DisplayAlerts = True


    Sheets.Add
    ActiveSheet.Name = "Journal_PNP"


    Range("A1") = "Année"
    Range("B1") = "Matricule"
    Range("C1") = "Budget"
    Range("D1") = "Code analytique"
    Range("E1") = "Acronyme"
    Range("F1") = "Département"
    Range("G1") = "Sexe"
    Range("H1") = "Nom"
    Range("I1") = "Prénom"
    Range("J1") = "Nationalité"
    Range("K1") = "Encadrant"
    Range("L1") = "Type de contrat"
    Range("M1") = "Catégorie"
    Range("N1") = "Intitulé de poste"
    Range("O1") = "Date d'entrée"
    Range("P1") = "Date de sortie"
    Range("Q1") = "Salaire brut/Bourse EGIDE"
    Range("R1") = "Transport/Complément EGIDE"
    Range("S1") = "Ch.patr./Frais de gest.TTC"
    Range("T1") = "Prov.chômage"
    Range("U1") = "Ma.sal.charg transport/EGIDE TTC"
    Range("V1") = "Msc transp sans prov. chômage"
    Range("W1") = "EGIDE HTR"
    Range("X1") = "Cumul EGIDE HTR"
    Range("Y1") = "TVA EGIDE non récupérable"
    Range("Z1") = "Cumul msc transport code ana"
    Range("AA1") = "Cumul msc transport poste"
    Range("AB1") = "Cumul msc transport personne"
    Range("AC1") = "Mois"
    Range("AD1") = "ETPV"
    Range("AE1") = "ETPTV"
    Range("AF1") = "Type de contrat"
    Range("AG1") = "Quotité du temps"
    Range("AH1") = "Historique des statuts"
    Range("AI1") = "Financement"


    With Range("A1:AI1")
        .Font.Bold = True
        .Font.Size = 8
        .Font.Name = "Arial"
        .Interior.Color = RGB(153, 204, 0)
    End With


    Rows("2:2").Select
    ActiveWindow.FreezePanes = True
    Range("A2").Select


    For i = Year(Date) - 4 To Year(Date)
        With Worksheets("Journal_PNP")
            ld = .Range("H65536").End(xlUp).Row + 1
        End With


        With Worksheets(CStr(i))
        .Activate
            DerL = .Range("A65536:AH65536").End(xlUp).Row
            .Range("A3:AH" & DerL).Copy Destination:=Worksheets("Journal_PNP").Range("B" & ld)
            lf = Worksheets("Journal_PNP").Range("B65536").End(xlUp).Row
            Worksheets("Journal_PNP").Range("A" & ld & ":A" & lf).Value = i
        End With
    Next i


    Application.DisplayAlerts = False
    For Each Ws In ActiveWorkbook.Worksheets
        If Ws.Name = "Synthèse" Then
            Ws.Delete
            Exit For
        End If
    Next
    Application.DisplayAlerts = True


    Sheets.Add
    ActiveSheet.Name = "Synthèse"
    Range("A1") = "Code analytique"
    Range("B1") = "Acronyme"
    Range("C1") = Year(Date)
    Range("D1") = "Avant " & Year(Date)


    With Range("A1:D1")
        .Font.Bold = True
        .Font.Size = 8
        .Font.Name = "Arial"
        .Interior.Color = RGB(153, 204, 0)
    End With


    Set d = CreateObject("Scripting.Dictionary")
    Application.ScreenUpdating = False
    With Worksheets("Journal_PNP")
        DerL = .Range("A65536:AH65536").End(xlUp).Row
        For l = 2 To DerL
            d(.Cells(l, 4).Value) = .Cells(l, 4).Value
        Next


        .Range("D2:D" & DerL).Name = "ColD"
        .Range("U2:U" & DerL).Name = "ColU"
    End With


    With Worksheets("Synthèse")
        l = 2
        For Each Item In d.items
            .Range("A" & l).Value = Item
            l = l + 1
        Next
        DerL = .Range("A65536").End(xlUp).Row


        For l = 2 To DerL
            Range("D" & l).Value = Application.WorksheetFunction.SumIf(Range("ColD"), .Range("A" & l), Range("ColU"))
        Next
    End With


    Rows("2:2").Select
    ActiveWindow.FreezePanes = True


    Range("B2:B" & DerL).Formula = "=VLOOKUP(RC[-1],Journal_PNP!C[2]:C[3],2,0)"


    With Rows("1:1")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Columns("A").EntireColumn.AutoFit


   With Range("A1:D" & DerL)
        .Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess
        .Borders.LineStyle = xlNone
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThin
        .Borders.ColorIndex = xlAutomatic
    End With


    With Range("C2:C" & DerL)
        .NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
        .Replace What:="", Replacement:="0", LookAt:=xlPart
    End With
    
Sheets("Synthèse").Move Before:=Sheets(2)
    Range("A2").Select
    ActiveWorkbook.Save
End Sub

A + à tous

yoldas · 10 Juin 2012

Re : [Besoin encore d'un peu d'aide]Retraiter des bases, les réunir et faire un TCD

Merci d'avoir pris le temps de me répondre en ce dimanche matin =)

Alors après avoir testé, cela ne fonctionne pas.
Je viens de rajouter un onglet 2013 puis deuxième test, rajout d'une ligne au journal_PNP, avec pour année 2013 et, lorsque je rajoute l'onglet, il n'est pas ramené dans le journal, et infine peu importe le test, les entêtes du tableau synthèse n'en ont pas tenu compte.
Autre petite chose, la somme de par code analytique de l'année en cours n'a pas été rempli. Tout a été mis dans "avant 2012".

Si vous n'avez pas la possibilité de revenir sur le code, ce n'est pas grave.
Je pense avoir les éléments de réflexion pour y arriver peut-être par moi-même.

En tout cas, encore un grand merci.
Je vous souhaite un bon dimanche, et un bon vote

Mes amitiés,
Yoldas

JCGL · 10 Juin 2012

Re : [Besoin encore d'un peu d'aide]Retraiter des bases, les réunir et faire un TCD

Bonjour à tous,

Modifie cette ligne pour la feuille 2013 :

VB:

For i = Year(Date) - 4 To Year(Date)+1

Pour le reste, je n'ai fait que modifier ton code.

A + à tous

yoldas · 10 Juin 2012

Re : [Besoin encore d'un peu d'aide]Retraiter des bases, les réunir et faire un TCD

En fait, ce que vous avez fait au départ était juste.
Cela m'a fait du bien d'aller prendre un peu l'air puisque ça m'a démêlé les pinceaux

En 2013, l'onglet 2013 sera bien pris en compte. Je viens de faire le test en modifier la date de windows. Et dans ce sens ce sera toujours bon. C'est plutôt dans l'autre sens que cela pose un problème.
En effet, ce fichier qui sert au suivi de la masse salariale dans le cadre de projet, peut être amené à la suivre sur une période allant jusqu'à 10 ans.
Donc year -4 omettrait une partie des données. Déjà en ajoutant l'onglet 2013, je remarque que 2008 n'est plus pris en compte, je vais essayer de -10, et vérifier que cela ne plante pas.

Merci encore

Edit : c'est bien ce que je craignais. A -5 ça passe, 2008 est pris en compte. A -10, lorsqu'il scanne les onglets il les trouve pas -logique- et plante. argh !

Edit 2 : peut-on mettre cette partie du code dans une boucle if ? comme ça s'il ne trouve pas, il s'arrête..

JCGL · 10 Juin 2012

Re : [Besoin encore d'un peu d'aide]Retraiter des bases, les réunir et faire un TCD

Bonjour à tous,

Au plus simple si le reste de la programmation donne satisfaction :

VB:

For i = Year(Date) - 10 To Year(Date) + 1
        With Worksheets("Journal_PNP")
            ld = .Range("H65536").End(xlUp).Row + 1
        End With
        
On Error Resume Next


        With Worksheets(CStr(i))
            .Activate

A + à tous

yoldas · 10 Juin 2012

Re : [Besoin encore d'un peu d'aide]Retraiter des bases, les réunir et faire un TCD

Je m'incline bien bas.

Marci mon seigneur !

A+

Bebere · 10 Juin 2012

Re : [Besoin encore d'un peu d'aide]Retraiter des bases, les réunir et faire un TCD

bonjour Yoldas,Jcgl
code dans module2
à bientôt

yoldas · 10 Juin 2012

Re : [Besoin encore d'un peu d'aide]Retraiter des bases, les réunir et faire un TCD

Merci Bebere !

Y'a un truc que je ne comprends pas sur mon code.
Il me met 2007 à la place de mettre Année en A1 dans mon onglet Journal_PNP -__-

Option Explicit

'Déclaration des variables
Sub maj_pnp()
Dim Ws As Worksheet
Dim i%, ld%, DerL%, lf%, l%
Dim d As Object
Dim Item

'Cache le message de suppression de feuille & supprime la feuille nommée Journal_PNP si elle existe
Application.DisplayAlerts = False
For Each Ws In ActiveWorkbook.Worksheets
If Ws.Name = "Journal_PNP" Then
Ws.Delete
Exit For
End If
Next

'Rend visible le message de suppression de feuille
Application.DisplayAlerts = True

'Crée une feuille Journal_PNP
Sheets.Add
ActiveSheet.Name = "Journal_PNP"

'Nomme les entêtes de la feuille Journal_PNP
Range("A1") = "Année"
Range("B1") = "Matricule"
Range("C1") = "Budget"
Range("D1") = "Code analytique"
Range("E1") = "Acronyme"
Range("F1") = "Département"
Range("G1") = "Sexe"
Range("H1") = "Nom"
Range("I1") = "Prénom"
Range("J1") = "Nationalité"
Range("K1") = "Encadrant"
Range("L1") = "Type de contrat"
Range("M1") = "Catégorie"
Range("N1") = "Intitulé de poste"
Range("O1") = "Date d'entrée"
Range("P1") = "Date de sortie"
Range("Q1") = "Salaire brut/Bourse EGIDE"
Range("R1") = "Transport/Complément EGIDE"
Range("S1") = "Ch.patr./Frais de gest.TTC"
Range("T1") = "Prov.chômage"
Range("U1") = "Ma.sal.charg transport/EGIDE TTC"
Range("V1") = "Msc transp sans prov. chômage"
Range("W1") = "EGIDE HTR"
Range("X1") = "Cumul EGIDE HTR"
Range("Y1") = "TVA EGIDE non récupérable"
Range("Z1") = "Cumul msc transport code ana"
Range("AA1") = "Cumul msc transport poste"
Range("AB1") = "Cumul msc transport personne"
Range("AC1") = "Mois"
Range("AD1") = "ETPV"
Range("AE1") = "ETPTV"
Range("AF1") = "Type de contrat"
Range("AG1") = "Quotité du temps"
Range("AH1") = "Historique des statuts"
Range("AI1") = "Financement"

'Formatage des entêtes
With Range("A1:AI1")
.Font.Bold = True
.Font.Size = 8
.Font.Name = "Arial"
.Interior.Color = RGB(153, 204, 0)
End With

'Fige la première ligne et se positionne au niveau de la cellule A2
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Range("A2").Select

'Recopie le contenu de tous les onglets autre que Journal_PNP dans Journal_PNP
'Se positionne à la première ligne vide de l'onglet Journal_PNP pour copier le contenu des autres onglets
'Ramène l'année indiquée sur l'onglet en première colonne de l'onglet Journal_PNP (i)
For i = Year(Date) - 10 To Year(Date)
With Worksheets("Journal_PNP")
ld = .Range("H65536").End(xlUp).Row + 1
End With

On Error Resume Next

With Worksheets(CStr(i))
.Activate
DerL = .Range("A65536:AH65536").End(xlUp).Row
.Range("A3:AH" & DerL).Copy Destination:=Worksheets("Journal_PNP").Range("B" & ld)
lf = Worksheets("Journal_PNP").Range("B65536").End(xlUp).Row
Worksheets("Journal_PNP").Range("A" & ld & ":A" & lf).Value = i
End With
Next i

'Suppression de l'onglet Synthèse
Application.DisplayAlerts = False
For Each Ws In ActiveWorkbook.Worksheets
If Ws.Name = "Synthèse" Then
Ws.Delete
Exit For
End If
Next
Application.DisplayAlerts = True

'Création de l'onglet Synthèse et formatage
Sheets.Add
ActiveSheet.Name = "Synthèse"
Range("A1") = "Code analytique"
Range("B1") = "Acronyme"
Range("C1") = Year(Date)
Range("D1") = "Avant " & Year(Date)

With Range("A11")
.Font.Bold = True
.Font.Size = 8
.Font.Name = "Arial"
.Interior.Color = RGB(153, 204, 0)
End With

'Journal_PNP vers synthèse des codes analytique sans doublon
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
With Worksheets("Journal_PNP")
DerL = .Range("A65536:AH65536").End(xlUp).Row
For l = 2 To DerL
d(.Cells(l, 4).Value) = .Cells(l, 4).Value
Next

.Range("D2" & DerL).Name = "ColD"
.Range("U2:U" & DerL).Name = "ColU"
End With

With Worksheets("Synthèse")
l = 2
For Each Item In d.items
.Range("A" & l).Value = Item
l = l + 1
Next
DerL = .Range("A65536").End(xlUp).Row

'Somme par code analytique et par année
For l = 2 To DerL
Range("D" & l).Value = Application.WorksheetFunction.SumIf(Range("ColD"), .Range("A" & l), Range("ColU"))
Next
End With

'Fige la première ligne et se positionne au niveau de la cellule A2
Rows("2:2").Select
ActiveWindow.FreezePanes = True

'RechercheV sur le code analytique pour ramener l'intitulé depuis l'onglet Journal_PNP
Range("B2:B" & DerL).Formula = "=VLOOKUP(RC[-1],Journal_PNP!C[2]:C[3],2,0)"

'Centre les titres et ajuste la taille des colonnes A à D au contenu
With Rows("1:1")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Columns("A").EntireColumn.AutoFit

'Dessine des bordures au tableau et trie les données par ordre alphabétique
With Range("A1" & DerL)
.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess
.Borders.LineStyle = xlNone
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Borders.ColorIndex = xlAutomatic
End With

'Format comptable sans unité de mesure et sans décimale et remplace les cases vides par des 0
With Range("C2" & DerL)
.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
.Replace What:="", Replacement:="0", LookAt:=xlPart
End With

'Copier/Coller spécial valeur
Columns("A").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'Se positionne en cellule A2 et remet de l'ordre dans les onglets
Range("A2").Select
Sheets("Journal_PNP").Move Before:=Sheets("2008")
Sheets("Synthèse").Move Before:=Sheets("Journal_PNP")

' Enregisrer le classeur actif
ActiveWorkbook.Save
End Sub

JCGL · 10 Juin 2012

Re : [Besoin encore d'un peu d'aide]Retraiter des bases, les réunir et faire un TCD

Bonjour à tous,

Peux-tu essayer :

VB:

 lf = Worksheets("Journal_PNP").Range("B65536").End(xlUp).Row + 1

A + à tous

[Resolu]Retraiter des bases, les réunir et faire un TCD

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Nouveau

Pièces jointes

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

Discussions similaires

Partager cette page

Statistiques des forums