Bonjour à tous,
J'ai un problème qui concerne le transfert de données entre deux feuilles d'un même fichier.
Ce fichier concerne l'ensemble des travaux que la ville de Grenoble a réalisé (ou doit réaliser) entre 2011 et 2020 et est composé de deux feuilles :
- Feuille "Données" ==> correspond à l'ensemble des travaux réalisés ou à réaliser entre 2011 et 2020 (1 ligne = 1 travail)
- Feuille "Annexe1" ==> correspond aux travaux réalisés sur une année spécifique
Le but de cet annexe est que l'on choisisse l'année que l'on souhaite consulter, par l'intermédiaire d'une liste déroulante placée en colonne D ligne 2.
Par exemple, si je choisis dans cette cellule l'année 2012 et que je clique sur le bouton "Valider" (auquel ma macro est affectée), il faudrait que tous les travaux prévus pour 2012 apparaissent dans cet annexe. Idem si je choisis une autre année.
Cette information concernant l'année est précisée en colonne H de mon onglet "Données"
J'ai mi au point un code VBA (copier d'un autre code que j'avais mis en place il y a longtemps, car cela fait longtemps que je n'ai pas utiliser ce langage) :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39 Sub Annexe1() 'Déclaration des variables' Dim MonAnnée As Integer Dim Feuille_Source As Worksheet Set Feuille_Source = Worksheets("Données") Dim Feuille_Cible As Worksheet Set Feuille_Cible = Worksheets("Annexe1") Dim lig As Long Dim DerLig As Long, ligne_Fin As Long Dim end_Line As Long 'Récupération de la dernière ligne remplie' DerLig = Feuille_Source.Range("B" & Rows.Count).End(xlUp).Row 'Copie de la dernière ligne remplie' For lig = 104 To DerLig Feuille_Source.Activate MonAnnée = Trim(Feuille_Source.Cells(lig, 8).Value) Feuille_Source.Range(Cells(lig, 4), Cells(lig, 6), Cells(lig, 7), Cells(lig, 8), Cells(lig, 11), Cells(lig, 10), Cells(lig, 26), Cells(lig, 27), Cells(lig, 28), Cells(lig, 13), Cells(lig, 29), Cells(lig, 30), Cells(lig, 31), Cells(lig, 32)).Copy Feuille_Cible.Activate 'Recherche du programme correspondant puis copie de la ligne à la suite de ce programme" ligne_Fin = Range("b" & Rows.Count).End(xlUp).Row Set R = Feuille_Cible.Range(Cells(2, 4)).Find(MonAnnée, lookat:=xlWhole) If Not R Is Nothing Then ligneDeb = R.Row End If nbVal = Application.WorksheetFunction.CountIf(Range(Cells(ligneDeb, 8), Cells(ligne_Fin, 8)), MonAnnée) - 1 end_Line = ligneDeb + nbVal Feuille_Cible.Cells(end_Line + 1, 2).Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Application.CutCopyMode = False Next lig End Sub
Ce code bloque à la ligne :
Feuille_Source.Range(Cells(lig, 4), Cells(lig, 6), Cells(lig, 7), Cells(lig, 8), Cells(lig, 11), Cells(lig, 10), Cells(lig, 26), Cells(lig, 27), Cells(lig, 28), Cells(lig, 13), Cells(lig, 29), Cells(lig, 30), Cells(lig, 31), Cells(lig, 32)).Copy
Avez-vous une idée de la cause de ce blocage à cette ligne ? Et pensez-vous que ce code correspond bien à ce que je veux faire ?
Merci d'avance pour vos réponses !
Partager