A partir d'un code recherché les actions effectuées
Bonjour tout le monde
je suis débutant sur VBA et j'ai longtemps hésité à poser ma question ,mais je n'avance pas.
Le but de la première opération est de copier tous les codes de dossier ouvert présent sur une feuille "semaine 18" à "semaine x" ; en sélectionnant spécifiquement une rangée "b" à partie de la ligne "25" sur une autre feuille nommée simplement "feuil1" et en ne sélectionnant que les cases remplis par un code.
Le problème de mon code est qu'il recopie le dernier code présent dans la feuille 18 sur les lignes vide de la "feuil1" alors que je voudrais qu'il saute à la prochaine ligne. j'aimerais a terme qu'il ne recopie que les codes des dossiers ouverts sans le texte total dossier ou total dossier avec le nom de la personne.
Je reste connecté si un membre à une question et joint le tableau Excel
Merci d'avance
Sub copie()
ThisWorkbook.Activate
' selection de la cellule de la condition du filtre
Sheets("Semaine 19").Activate
'Action de filtrage
Range("B25:B" & [B65000].End(xlUp).Row).Select
' permet la selection d' un debut jusqu'a la cellule à la fin de la région contenant la plage de sources, en l'occurance b25
Selection.Copy
'selection du lieu de collage
Sheets("feuil1").Select
Range("a1").Select
'Collage
ActiveSheet.Paste
End SubLa suite de l'opération consiste à partir de la feuille 1, qui contient les codes des dossiers ouverts de toutes les feuilles, de rechercher via les codes des dossiers toutes les opérations qui ont été effectuées dans les différentes feuilles.
Cela me permettrait de savoir rapidement, quand les dossiers ont été repris, relancés ou clôturés.
j'ai écrit une deuxième macro beaucoup plus complexe que la première qui ne fonctionne pas évidemment pas vu mon niveau actuel en macro.
Je suis preneur de toutes suggestions.
Merci d'avance
Sub recherche_code()
Dim nom_feuil As String
Dim nb_lig As Integer
Dim nb_col As Integer
Dim deb As Integer
Dim lig_code As Integer
Dim val_cher As String
Dim val_trouve As String
Dim num_feuil As Integer
Dim dernier As Integer
Dim code_cher As String
Dim m As Integer
Dim n As Integer
Dim j As Integer
Dim k As Integer
Dim prem As Integer
Dim dern As Integer
ThisWorkbook.Activate
Sheets("feuil1").Select
deb = 1 ' numéro de la ligne de début du nom de code à rechercher dans dossiers complets
j = 1 ' numéro de colonne de début du nom de code à rechercher dans dossiers complets
lig_code = 18 'numéro de la ligne ou se situe les noms des codes dossier dans les feuilles "semaine *"
'numéro de la première feuille nommée "semaine " pour la recherche
dern = 300 ' derniere ligne de recherche dans les feuilles "semaine*"
k = lig_code
dernier = ThisWorkbook.Sheets.Count
Sheets("feuil1").Select
val_cher = CStr(Sheets("feuil1").Cells(deb, 2).Value)
'While Cells(deb + 1, 2).Value <> "" And Cells(deb + 2, 2).Value <> ""
While deb < 300
If Cells(deb, 2).Value <> "" Then
deb = deb + 1
Else
val_cher = CStr(Sheets("feuil1").Cells(deb, 2).Value)
num_feuil = 7
Sheets(num_feuil).Select
For m = num_feuil To dernier
If Left(Sheets(m).Name, 7) = "Semaine" Then 'Si les 7 primers caractère du nom de la feuille est : semaine
For n = 1 To 70
code_cher = CStr(Sheets(m).Cells(lig_code, n).Value)
If Left(code_cher, 4) = "Code" Then
prem = n - 1
While k < dern
Sheets(m).Select
val_trouve = CStr(Cells(k, prem).Value)
If val_cher = val_trouve Then 'si la valeur cherchée dans Dossiers complets = valeur trouvée dans semaine
nom_feuil = Sheets(m).Name
Sheets("feuil1").Select
ActiveSheet.Range("H" & deb) = code_cher
ActiveSheet.Range("I" & deb) = nom_feuil
Exit For
Exit For
End If
k = k + 1
Wend
End If
n = n + 1
Next n
End If
m = m + 1
Next m
End If
Sheets("feuil1).Select
deb = deb + 1
Wend
End Subj'ai réessayé sans sucés
j'ai un bug sur la ligne code_cher = Cells(lig_code, n).Text
Helpppp
Sub MAJ()
Dim nom_feuil As String
Dim nb_lig As Integer
Dim nb_col As Integer
Dim deb As Integer
Dim lig_code As Integer
Dim val_cher As String
Dim num_feuil As Integer
Dim dernier As Integer
Dim code_cher As String
Dim j As Integer
Dim k As Integer
k = 1
ThisWorkbook.Activate
Sheets("feuil1").Select
deb = 1
j = 1
lig_code = 18
num_feuil = 7
dernier = ThisWorkbook.Sheets.Count
val_cher = Cells(deb, j).Text
MsgBox val_cher
Sheets(num_feuil).Select
For m = num_feuil To dernier
For n = 1 To 70
code_cher = Cells(lig_code, n).Text
While code_cher = ""
n = n + 1
code_cher = Cells(lig_code, n).Value
Wend
If code_cher = "code %" Then
MsgBox code_cher
End If
Next n
MsgBox Sheets(m)
Next m
End SubBonjour tout le monde.
Petit point j'ai réussi la première partie de ma macro qui consiste à copier les cellules des dossiers ouverts dans une autre feuille en sautant les espaces vides et les espaces égales à 0
Sub copie1()
Dim nom_fd As String
Dim nom_fa As String
Dim num As Integer
Dim ligd As Long
Dim cold As Long
Dim liga As Long
Dim cola As Long
liga = 1
cola = 1
num = 18
While num < 22
nom_fa = "Feuil1"
nom_fd = "semaine " & num
Dim fd As Worksheet
Dim fa As Worksheet
Set fa = ThisWorkbook.Worksheets(nom_fa)
Set fd = ThisWorkbook.Worksheets(nom_fd)
ligd = 25
cold = 2
While ligd < 500
While fd.Cells(ligd, cold).Text <> "" And fd.Cells(ligd, cold).Value <> 0
If fd.Cells(ligd, cold).Text Like "Tot*" Then
ligd = ligd + 2
liga = liga + 1
End If
fa.Cells(liga, cola) = fd.Cells(ligd, cold).Value
ligd = ligd + 1
liga = liga + 1
Wend
While fd.Cells(ligd, cold) = "" And ligd < 500
ligd = ligd + 1
Wend
While fd.Cells(ligd, cold) = 0 And ligd < 500
ligd = ligd + 1
Wend
If fd.Cells(ligd, cold).Text Like "Tot*" Then
ligd = ligd + 2
liga = liga + 1
End If
Wend
num = num + 1
Wend
End SubPar contre , je reste toujours bloqué pour la seconde partie qui consiste à partir de la feuille 1, qui contient les codes des dossiers ouverts de toutes les feuilles, de rechercher via les codes des dossiers toutes les opérations qui ont été effectuées dans les différentes feuilles ( reprise relance...) et la date de la dernière action
Cela me permettrait de savoir rapidement, quand les dossiers ont été repris, relancés ou clôturés.
Je suis preneur de toutes suggestions.
Merci d'avance
Up
Je poste sans réel espoir...
Nouveau dans la programmation, je dois louper des étapes basiques dans la programmation .
j'ai essayé de créer un code qui à partir de code présent dans une feuille "relance" ou sont présent tous les codes des dossiers ouverts par mon équipe, la dernière action effectuer à partir de ces codes je veux donc rechercher:si dans ma feuille dossiers complets le code est présent si oui il me marque dossier complets sinon il continue la recherche dans la feuille gestion si le code est présent il copie code gestion sinon il commence à rechercher dans les feuilles de la semaine qui correspondent aux semaines de l'année en cours la dernière action effectuer sur ce dossier.
pour résumer ce code me permet de savoir si donc mon dossier et complet ou en gestion et dans le cas contraire quelle est la dernière action effectuée dessus afin de ne pas en laissé de coté
Je prends la moindre piste et vous joint le fichier de base
Sub Recherche()
Dim feuil As Workbook
Dim semaine As String
Dim trouve As Range
Dim nb As Integer
Dim relance As Worksheet 'ok
Dim dos_gestion As Worksheet 'pas besoin
Dim dos_complet As Worksheet ' ok
Dim doc_gest As Worksheet 'ok
Dim dos_recu As Worksheet ' pas besoin
Dim graph As Worksheet ' pas besoin
Dim tot_sem As Worksheet ' ok
Dim sem As Worksheet ' ok
Dim ligd As Long
Dim cold As Long
Dim ligf As Integer
Dim colf As Long
Set feuil = ThisWorkbook
feuil.Activate
Set relance = feuil.Worksheets("Relance") ' on pose sur la table la feuille relance
Set doc_gest = feuil.Worksheets("Documents gestion") ' pas besoin on pose sur la table la feuille documents gestion
Set dos_gestion = feuil.Worksheets("Dossiers gestion") ' on pose sur la table la feuille dossier gestion
Set dos_complet = feuil.Worksheets("Dossiers complets") ' on pose sur la table la feuille dossiers complets
Set dos_recu = feuil.Worksheets("Dossiers recus + en stock") ' on pose sur la table dossiers recu + en stock
Set graph = feuil.Worksheets("Graphique") ' on pose sur la table la feuille graphique
Set tot_sem = feuil.Worksheets("Total par Semaine et ETP") ' on pose sur la table la feuille semaine par etp
semaine = "Semaine " ' il manque pas une etoile
feuil.Activate ' on active tte les feuille ?
relance.Select ' on selectionne la feuille relance
ligd = 4 ' debut de la recherche de code dans dossier relance
cold = 1 ' same
nb = feuil.Worksheets.Count
'------------------- je recherche dans la colonne A de relance---------
While relance.Cells(ligd, cold).Value <> "" Or relance.Cells(ligd + 1, cold).Value <> "" ' je ne comprend pas le or
Set trouve = dos_complet.Range("B1:B1000").Find(relance.Cells(ligd, cold).Value) ' on met sur la table les dossiers complets et on recherche le code
If trouve Is Nothing Then ' si on trouve rien, on s'arette
Set trouve = dos_gestion.Range("B1:B1000").Find(relance.Cells(ligd, cold).Value) 'on met sur la table les dossiers gestion et on recherche le code
If trouve Is Nothing Then ' si on trouve rien, on s'arette
Do While nb >= 9 ' peut etre probleme on commence la recherche avec un interrupteur de boucle a la 9eme feuille
Set sem = feuil.Worksheets(nb) ' on selectionne semaine
Set trouve = sem.Range("B1:BJ1000").Find(relance.Cells(ligd, cold).Value) ' on pose sur la table la semaine
If trouve Is Nothing Then ' si on trouve rien, on s'arette
nb = nb - 1 'sinon on passe a une autre feuille
Else
'ligf = trouve.Row
'While Not sem.Cells(ligf, trouve.Column).Value Like "Total*"
'ligf = ligf - 1
'Wend
relance.Cells(ligd, cold + 2) = sem.Name
'relance.Cells(ligd, cold + 3) = sem.Cells(ligf, trouve.Column).Text
Exit Do
End If ' peut etre a inverser avec le loop
Loop
ligd = ligd + 1 ' on passe a un autre code a rechercher
Else
relance.Cells(ligd, cold + 1) = "Dossiers gestion"
relance.Cells(ligd, cold + 3) = dos_gestion.Cells(trouve.Row, trouve.Column + 2).Value
ligd = ligd + 1
End If
Else
relance.Cells(ligd, cold + 1) = "Dossiers complets"
relance.Cells(ligd, cold + 2) = dos_complet.Cells(trouve.Row, trouve.Column + 2).Value
ligd = ligd + 1
End If
Wend
End Sub