Récupérer numéros de ligne excel
Bonjour à tous,
Je souhaite réaliser une fonction sur mon fichier excel qui me sélectionne plusieurs lignes de ma base données selon 1 critère, que chacune des lignes soit renseignée tour à tour dans un formulaire qui lui s'imprime alors pour finir- 1 formulaire l'un après l'autre. J'ai commencé à rédiger un code mais je rencontre des difficultés.
- Ma base de données
Pièce jointe 341557
Chaque case renseignée est un lien avec un autre fichier où l'on procède à la saisie manuelle des informations. Je souhaite trier ma base de données selon le critère de la 2ième colonne "Etat:" et afficher seulement les cases vides. Je souhaite ensuite copier une à une les lignes d'informations, puis coller tour à tour les valeurs dans une autre feuille de mon classeur dans une ligne choisie arbitrairement dont les cellules sont liées à mon formulaire suivant que je souhaite par la suite imprimer automatiquement:
Pièce jointe 341567
Dans mon code, je rencontre la difficulté suivante :
Une fois ma base de données triée selon le critère choisi, je compte le nombre de ligne non vide pour effectuer ma boucle. Je souhaite alors copier/coller une à une les lignes contenant de l'information mais je ne sais pas comment récupérer le bon indice de ligne qui me permettra de copier la bonne ligne pour la coller ensuite. C'est à dire les numéros de lignes excel associés à mes lignes voulues. De plus, selon le filtre les numéros de lignes ne se suivent pas ce qui rajoute une difficulté pour ma boucle.
J'espère avoir été assez clair pour expliquer ma difficulté.
- Mon code
Code:
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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
| Sub IMPRESSION_DEMANDES_EN_ATTENTE()
Dim i As Integer, derniere_ligne As Integer
With Worksheets("P.MICHAUD")
.Activate
.Unprotect Password:="LEAN"
On Error Resume Next
.ShowAllData
On Error GoTo 0
.Range("$A$1:$U$2266").AutoFilter Field:=2, Criteria1:="=" 'filtre -> case vide
derniere_ligne = Worksheets("P.MICHAUD").Range("A" & Rows.Count).End(xlUp).Row 'Compte nombre de ligne non vide
For i = 2 To derniere_ligne 'Mauvais indices choisis
Set rngSource = Worksheets("P.MICHAUD").Range("F" & i & ":S" & i) 'copie la ligne d'information voulue
With Worksheets("FORMULAIRE")
.Range("AH1").Resize(1, rngSource.Count).Value = rngSource.Value 'colle la ligne pour remplissage automatique du formulaire
.Range("B1:K32").Select
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.7)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Selection.PrintOut Copies:=1, Collate:=True
End With
Next
End With
End Sub |
