Deployer un code (qui marche) sur d'autre tableau

Bonjour

je souhaite déployer un code (permettant une extraction de données qui marche trés trés bien) sur d'autres tableau dans la meme feuille mais je ne sais pas comment modifier les codes pour cela.

c'est un code qui permet d'extraire des données d'un planning sur une autre feuille (c'est le fait de savoir qui a remplacé qui suivant le planning).

fichier ci-joint

merci d'avance pour votre aide

27planning-v4-1-2.xlsm (189.50 Ko)

Bonjour Lili, bonjour le forum,

De quel code parles-tu ? Ton fichier en est truffé...

Bonjour,

Pour nous éclairer ... peux-tu préciser quelle est la macro à laquelle tu fais référence ...

bonjour

c'est dans la partie 'Recherche de données.... remplissage du tableau 1 et du tableau 2

le code est uniquement fait pour le mois de janvier mais j'aimerais le deployer pour qu'il m'extrait les données sur février....

lili

LILI61 a écrit :

bonjour

c'est dans la partie 'Recherche de données.... remplissage du tableau 1 et du tableau 2

le code est uniquement fait pour le mois de janvier mais j'aimerais le deployer pour qu'il m'extrait les données sur février....

lili

Désolé ... mais en ce qui me concerne .. cette explication n'éclaire pas vraiment la situation ...

Bonjour le fil, bonjour le forum,

Pareil que James ! Autant dire j'abonde James...

ThauThème a écrit :

Bonjour le fil, bonjour le forum,

Pareil que James ! Autant dire j'abonde James...

Salut ThauThème

Autant le dire franchement ... c'est rassurant de savoir que je ne suis pas le seul

lol bon bein tant pis alors alors je vais faire une feuille par mois et adapter le code pour chaque feuille au lieu de le déployer sur la meme feuille

bisous à vous deux et merci

lili

Re,

Pourquoi ne pas nous donner tout simplement le nom de la macro dans ton fichier ...

re bonjour

je n'ai uniquement le fichier que j'ai joint tous à l'heure, tous dois y etre :

Option Explicit

Option Base 1

Dim xlgnremplt As Byte, i As Integer, j As Integer, xlgn As Integer, xcol As Integer, xlgn2 As Integer

Dim tblo1(), tblo2(), tblo3()

Dim xremplt As String, xmois As String, xmotif As String, xmes As Variant

Private Sub Cmdmajvalider_Click()

' Contrôle de la saisie d'un employé

For i = 0 To LBemployes.ListCount - 1

If LBemployes.Selected(i) = True Then

xremplt = LBemployes.List(i)

End If

Next i

If xremplt = "" Then

MsgBox "Vous devez sélectionner un employé."

LBemployes.SetFocus

Exit Sub

End If

' Contrôle de la saisie mois

For i = 0 To LBmois.ListCount - 1

If LBmois.Selected(i) = True Then

xmois = LBmois.List(i)

End If

Next i

If xmois = "" Then

MsgBox "Vous devez sélectionner un mois."

LBmois.SetFocus

Exit Sub

End If

' Recherches des données

' ----- remplissage du tableau 1 ----- A MODIFIER EN FONCTION DE LA GRANDEUR DU TABLEAU

ReDim tblo1(1 To 60, 1 To 33): ReDim tblo2(1 To 20, 1 To 33)

If xmois = "Janvier" Then

tblo1() = Sheets("annee").Range("C14:AI73").Value

Else

MsgBox "Code réalisé uniquement pour le mois de Janvier."

Worksheets("Absences").Activate

Range("A1").Select

Application.ScreenUpdating = True

Unload Me

Exit Sub

End If

' ----- remplissage du tableau 2 -----

xlgn2 = 1

For xlgn = LBound(tblo1, 1) To UBound(tblo1, 1)

If tblo1(xlgn, 1) = xremplt Then

For xcol = LBound(tblo1, 2) To UBound(tblo1, 2)

tblo2(xlgn2, xcol) = tblo1(xlgn, xcol)

Next xcol

xlgn2 = xlgn2 + 1

End If

Next xlgn

Call Afftblo2

' Affichage des informations

xlgn = 5: Sheets("absences").Cells(3, 5).Value = xremplt

Sheets("temp").Activate

For j = 3 To 35

If Cells(1, j) <> "" Then

Sheets("absences").Cells(xlgn, 2).Value = Cells(2, j) ' Personne remplacée lgn 2

Sheets("absences").Cells(xlgn, 3).Value = xmois ' Mois

Sheets("absences").Cells(xlgn, 4).Value = Cells(3, j) ' Motif lgn 3

Sheets("absences").Cells(xlgn, 5).Value = Cells(1, j) 'Horaire lgn 1

xlgn = xlgn + 1

End If

Next j

Worksheets("Absences").Activate

If Cells(5, 2) = "" Then MsgBox "Cette personne " & xremplt & " n'a effecué aucun remplacement pour le mois de" & Chr(10) & xmois, vbInformation, "Information"

Range("A1").Select

Application.ScreenUpdating = True

Unload Me

End Sub

Private Sub UserForm_Initialize()

Application.ScreenUpdating = False

With Sheets("bases")

.Activate

' ListBox Employes

For i = 3 To 22: UserForm1.LBemployes.AddItem Cells(i, 2): Next i

' ListBox Mois

For i = 2 To 13: UserForm1.LBmois.AddItem Cells(i, 7): Next i

End With

Sheets("temp").Range("A1:AJ5").ClearContents

End Sub

Private Sub Cmdmajretour_Click()

Unload Me

Worksheets("Absences").Activate

Range("A1").Select

Application.ScreenUpdating = True

End Sub

Private Sub Afftblo1()

' ----- affichage du tableau 1 -----

Sheets("Temp").Activate

For xlgn = LBound(tblo1, 1) To UBound(tblo1, 1)

For xcol = LBound(tblo1, 2) To UBound(tblo1, 2)

Cells(xlgn, xcol) = tblo1(xlgn, xcol)

Next xcol

Next xlgn

End Sub

Private Sub Afftblo2()

' ----- affichage du tableau 2 -----

Sheets("temp").Activate

For xlgn = LBound(tblo2, 1) To UBound(tblo2, 1)

For xcol = LBound(tblo2, 2) To UBound(tblo2, 2)

Cells(xlgn, xcol) = tblo2(xlgn, xcol)

Next xcol

Next xlgn

End Sub

Re,

Le code que tu viens de joindre est celui de l'UserForm ...

Est-ce bien cela ?

bonjour

oui c'est ça

LILI61 a écrit :

bonjour

oui c'est ça

Bonjour,

Si tu veux vraiment de l'aide ... pourquoi autant de mystères ...

Dans la feuille Année, où sont tes boutons de commande ? ... Comment est activé ton UserForm ? ...

Accessoirement, est-ce toi qui a déjà programmé le code de base ?

Bonjour le fil, bonjour le forum,

En pièce jointe ton fichier modifié.

19planning-v4-1-3.xlsm (194.96 Ko)

bonjour

bein là merci vraiment du coup de main..... chapeau !!

pour répondre à ta question : non ce n'est pas moi qui suis à l'origine du programme, on me l'a construit mais je n'arrive plus à contacter la personne qui l'a réalisé.

Merci sincèrement de votre précieuse aide

lili

Rechercher des sujets similaires à "deployer code qui marche tableau"