Discussion :

[choupetta]

bonjour tout le monde et merci pour ca site parcequ il ma été d un grand aide dans mes recherche
bon je suis une stagiaire et je dois automatiser un fichier qui sert à collecter des information journaliere afin de calculer des ppm et pour cela je dois chaque semaine prendre les différents information saisie et les copier dans une deusieme feuil j ai pas mal cherché et je suis tombé sur des exemple mais ca marché pas j ai attaché un fichier ou j ai essayer d expliquer encore plus pour mieux comprendre j espére que j été asseez clair
merci

[Invité]

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
Option Explicit
 
Public Sub RechercheDonnees()
 
    Dim intSemaine As Integer, intligne As Integer
    Dim rngC As Range
    Dim strAdr As String
 
    intligne = 1
    Worksheets("Feuil2").Cells.Clear
 
    With Worksheets("Feuil1")
 
        intSemaine = .[G17].Value
        Set rngC = .Columns(1).Find(intSemaine, , , xlWhole)
 
        If rngC Is Nothing Then
            MsgBox ("Pas de données !")
            Exit Sub
        Else
            strAdr = rngC.Address
            Do
                .Rows(rngC.Row).Copy Worksheets("Feuil2").Range("A" & intligne)
                intligne = intligne + 1
                Set rngC = Columns(1).FindNext(rngC)
            Loop While rngC.Address <> strAdr
        End If
 
    End With
End Sub

Un exemple est en PJ.

[casefayere]

Bonjour,

Une autre solution avec une variable tableau, à adapter :

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
Sub copiage()
Dim Tbl, x As Integer, dl As Integer, NbG17 As Integer, y As Integer
With Sheets("Feuil1")
  dl = .Range("A" & .Rows.Count).End(xlUp).Row
  NbG17 = WorksheetFunction.CountIf(.Range("A2:A" & dl), .Range("G17")) 'sur ton exemple c'est G17 et non G16
  ReDim Tbl(1 To NbG17, 1 To 3) 'pour 3 colonnes
  y = 0
  For x = 2 To dl
    If .Range("A" & x) = .Range("G17") Then 'sur ton exemple c'est G17 et non G16
      y = y + 1
      Tbl(y, 1) = .Range("A" & x)
      Tbl(y, 2) = .Range("B" & x)
      Tbl(y, 3) = .Range("C" & x)
    End If
  Next x
  Sheets("Feuil2").Range("C8").Resize(UBound(Tbl), 3) = Tbl
End With
End Sub

Une nouvelle proposition basée sur la première avec un nombre de colonnes variable

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
Sub copiage()
Dim Tbl, x As Integer, dl As Integer, dc As Integer, NbG17 As Integer, y As Integer, z As Integer
With Sheets("Feuil1")
  dl = .Range("A" & .Rows.Count).End(xlUp).Row
  dc = .Cells(1, .Columns.Count).End(xlToLeft).Column
  NbG17 = WorksheetFunction.CountIf(.Range("A2:A" & dl), .Range("G17")) 'sur ton exemple c'est G17 et non G16
  ReDim Tbl(1 To NbG17, 1 To dc) 'pour nombre de colonnes variables
  y = 0
  For x = 2 To dl
    If .Range("A" & x) = .Range("G17") Then
      y = y + 1
      For z = 1 To dc
        Tbl(y, z) = .Cells(x, z)
      Next z
    End If
  Next x
  Sheets("Feuil2").Range("C8").Resize(UBound(Tbl), dc) = Tbl
End With
End Sub

[choupetta]

c bon ca a marché merci bcp

re bonjour
le programme marche bien sauf que j ai un petit soucis pask les collonne se colle en b1 et moi j vx qu il se colle une peux en bas si vous puvez m aider svp
merci

[casefayere]

je ne comprends pas :

... les colonnes se colle en b1 et moi j vx qu'elles se collent un peu en bas si vous pouvez m aider svp

je ne sais pas quelle solution tu as adoptée mais si c'est la mienne

Code :

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

Sheets("Feuil2").Range("C8").Resize(UBound(Tbl), dc) = Tbl

donc tout se colle à partir de "C8", si c'est le code proposé par vcottineau :

Code :

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

1
2
3
...
Worksheets("Feuil2").Range("A" & intligne)
...

tout est collé à partir de la colonne A