Discussion :

[jeff1494]

Bonsoir à tous;
Je reviens vers vous car j'aimerais pouvoir modifier le code suivant :

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
 
Private Sub CommandButton1_Click()
Dim lastlig As Long, i As Long, j As Long
Dim mot As String
Dim c As Range
Dim tablo() As String
 
lastlig = Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
mot = InputBox("Mot cherché")
mot = "*" & Ucase(mot) & "*"
ReDim tablo(1)
j = 0
Range("B2:B" & lastlig).Interior.ColorIndex = xlNone
For Each c In Range("B2:B" & lastlig)  'à adapter
    If Ucase(c.Value) Like mot Then
        tablo(j) = c.Value
        c.Interior.ColorIndex = 4
        ReDim Preserve tablo(UBound(tablo) + 1)
        j = j + 1
    End If
Next c
Sheets("Feuil2").Columns("A:A").ClearContents
For i = 0 To UBound(tablo)
    Sheets("Feuil2").Range("A" & i + 1) = tablo(i)
Next i
End Sub

Ce code copie une cellule sur une feuille2 si elle contient un certain mot.
Moi j'aimerais copier la ligne entière sur la feuille 2 en commençant en ligne 2.
Je ne suis pas du tout familier avec les tableaux. Alors siquelqu'un pouvait m'aider.
D'avance merci pour votre aide.
Cordialement.

[mercatog]

la réponse dans l'autre post (que je vais supprimer)

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
Private Sub CommandButton1_Click()
Dim lastlig As Long, i As Long, j As Long
Dim mot As String
Dim c As Range
Dim tablo() As String
 
lastlig = Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
mot = InputBox("Mot cherché")
mot = "*" & UCase(mot) & "*"
ReDim tablo(1)
j = 0
Range("B2:B" & lastlig).Interior.ColorIndex = xlNone
For Each c In Range("B2:B" & lastlig)  'à adapter
    If UCase(c.Value) Like mot Then
        tablo(j) = c.Row
        c.Interior.ColorIndex = 4
        j = j + 1
    End If
Next c
Sheets("Feuil2").Columns("A:A").ClearContents
For i = 0 To UBound(tablo)
    Rows(tablo(i)).Copy Sheets("Feuil2").Range("A" & i + 1)
Next i
End Sub

en prend le n° de la ligne dans tablo
et on copie la ligne entière dans feuil2

[Abed_H]

Bonsoir
sans tableau

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub CommandButton1_Click()
    Dim lastlig As Long, mot As String, c As Range
    lastlig = Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
            mot = InputBox("Mot cherché")
            mot = "*" & UCase(mot) & "*"
Range("B2:B" & lastlig).Interior.ColorIndex = xlNone
For Each c In Range("B2:B" & lastlig)
    If UCase(c.Value) Like mot Then
        Feuil2.Range("B65536").End(xlUp)(2).Resize(1, 10).Value = c.Resize(1, 10).Value ' ou 10 le nombre de cellules à copiées
        c.Interior.ColorIndex = 4
    End If
Next c
End Sub

Bonne nuit à vous deux

[mercatog]

à force de changer dans un précédent post, on arrive à des "absurdités" involontaires
ou ceci

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
Private Sub CommandButton1_Click()
Dim lastlig As Long, j As Long
Dim mot As String
Dim c As Range
 
lastlig = Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
mot = InputBox("Mot cherché")
mot = "*" & UCase(mot) & "*"
j = 2
Sheets("Feuil2").Cells.ClearContents
 
Range("B2:B" & lastlig).Interior.ColorIndex = xlNone
For Each c In Range("B2:B" & lastlig)  'à adapter
    If UCase(c.Value) Like mot Then
        Rows(c.Row).Copy Sheets("Feuil2").Range("A" & j)
        c.Interior.ColorIndex = 4
        j = j + 1
    End If
Next c
End Sub

[jeff1494]

Bonjour Mercatog, Abel_H, et le forum;
Merci à vous deux pour vos solutions. C'est parfait.
Bonne journée à tous.
Cordialement.