Discussion :

[Prisme974]

Bonjour à tous,


Je souhaiterais copier un ensemble de cellules de plusieurs feuilles (H1, H2, ...) sur une feuille Feuil1.
Le problème est que la 1ère ligne que je dois copier ainsi que la dernière ligne ne sont pas les mêmes sur chaque feuille. (exemple sur H1 on va copier de A36 à B40, sur H2 de A20 à B30, ...
Le nombre de feuilles H n'est pas fixe, on peut en ajouter tant qu'on veut.
Les feuilles se présentent selon ce modèle :

	A	B
1
2
...
8
9	Fournitures :
10	40	plants en godets
11	18	gaines agroforestières
...
20	19	tuteurs bambou

J'essaie de sélectionner les cellules entre la ligne située en-dessous de la cellule "Fournitures :" jusqu'à la fin du tableau (il n'y a rien en dessous).
J'ai donc opté pour une boucle :

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
Dim dlgR As Integer, dlgi As Integer
    Dim i As Byte
 
    'pour chaque feuille dans ce classeur si la feuille est différente de "page"...
        For Each F In ThisWorkbook.Sheets
            If F.Name <> "page" Then
                'déterminer 1ère ligne
                    'retrouver la cellule contenant "Fournitures :"
                        Cells.Find("Fournitures :", , xlValues, xlWhole).Select
                    'Descendre d'1 cellule vers le bas
                        premiere_ligne = ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
 
                'on souhaite coller les données de chaque feuille sur la "Feuil1", à partir de la colonne A  :
                dlgR2 = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
 
                dlgi2 = F.Range("B" & Rows.Count).End(xlUp).Row
                    'F.Range("A" & premiere_ligne & ":B" & dlgi2).Copy Sheets("Feuil1").Range("A" & dlgR2 + 1)
               End If
        Next

Mais la ligne "Cells.Find("Fournitures :", , xlValues, xlWhole).Select" ne semble pas fonctionner. Y a t'il une erreur de syntaxe ?

Merci par avance de votre aide et bonne journée !

[BENNASR]

bonjour
pour commencer tu peux déterminer le numéro de la ligne et le numéro de la colonne comme suit :
NB : définir la dernière ligne comme "long" et n'ont pas "integer"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub test()
Dim F As Worksheet
        For Each F In ThisWorkbook.Sheets
            If F.Name <> "page" Then
                  Set C = F.Cells.Find("Fournitures :", , xlValues, xlWhole)
                  If Not C Is Nothing Then
                  MsgBox C.Row & "  /  " & C.Column
               End If
            End If
        Next F
End Sub

et si à chaque fois tu cherches la colonne ou existe le mot "Fournitures :" et tu copie toutes les données jusqu'à la fin de la colonne dans l'onglet "page"; idem pour les autres feuilles
tester ça :

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
Sub test()
Dim F As Worksheet
Dim derlig As Long
Application.ScreenUpdating = False
L = 2
        For Each F In ThisWorkbook.Sheets
            If F.Name <> "page" Then
                  Set C = F.Cells.Find("Fournitures :", , xlValues, xlWhole)
                  If Not C Is Nothing Then
                  Lig = C.Row
                  col = C.Column
                  derlig = F.Cells(Rows.Count, col).End(xlUp).Row
                  F.Range(F.Cells(Lig + 1, col), F.Cells(derlig, col)).Copy
                  Sheets("page").Cells(L, 1).PasteSpecial Paste:=xlPasteValues
               End If
            End If
        L = Sheets("page").Cells(Rows.Count, 1).End(xlUp).Row + 1
        Next F
Application.ScreenUpdating = True
End Sub

[Prisme974]

Super, ça fonctionne, merci beaucoup !
A quoi sert le Application.ScreenUpdating = True ?

[BENNASR]

pour arrêter l'affichage écran et gagner en temps d'exécution surtout dans le cas d'une grande base de données
mais n'oublier pas à mettre en true en fin de code