XL 2013 Ne pas copier les lignes complètes

[Usine à gaz]

Bonjour à toutes et à tous,

ça fait longtemps et comme je vais mieux (pour l'instant), je me remets à l'amélioration de mes connaissances et, bien entendu, j'ai besoin de votre aide si précieuse.

Voici ma problématique :
J'ai un code que je pense avoir trouvé ici (comme d'hab )

Sub Copie()
    Dim L As Long
    Dim LignesSel As Range
    For Each cel In Feuil1.Range("A2:A" & [A2].End(xlDown).Row)
        If cel.Value = "juju" Or cel.Value = "lola" Then
            If Not LignesSel Is Nothing Then
                Set LignesSel = Union(LignesSel, cel.EntireRow)
            Else
                Set LignesSel = cel.EntireRow
            End If
        End If
    Next
    If Not LignesSel Is Nothing Then LignesSel.Copy Feuil2.[A2]
    Feuil2.Select
    [A1].Select
End Sub

Il fonctionne parfaitement et j'en remercie encore l'auteur

Ce code copie les lignes entièrement et j'aurais besoin qu'il de me copie qu'une partie des lignes, par exemple toutes les lignes col A à D

Et ça, je ne sais pas faire et malgré mes recherches et essais, j'ai pas trouvé.

Auriez-vous la solution ? LOL ça m'arrangerait bien

Je joins le fichier test.
Un grand merci pour tout ce que vous faites.
Bonne journée à toutes et à tous,
Amicalement,
Arthour973,

 

[Usine à gaz]

Encore un grand merci, ça fonctionne nickel

 

[zebanx]

Je te remercie @arthour973

Sans oublier que c'est surtout le code de Job75

@+

 

[Usine à gaz]

Bien sûr, je n'oublie pas mais merci aussi à toi

 

[job75]

Bonjour Lionel, zebanx,

Si l'on utilise la fonction End(3) pour définir le tableau Feuil1 ne doit pas être filtrée.

En utilisant UsedRange ça n'a pas d'importance.

Mais Feuil2 ne doit pas être filtrée non plus :

Sub FiltrerColonneB()
Dim t, F As Worksheet, tablo, i&, n&, j%, t0
t = Timer
Set F = Feuil2 'CodeName de la feuille de destination
If F.FilterMode Then F.ShowAllData 'si la feuille est filtrée
F.Range("A2:C" & F.Rows.Count).ClearContents 'RAZ
tablo = Feuil1.UsedRange.Columns("B:D") 'matrice, plus rapide
For i = 2 To UBound(tablo)
    If tablo(i, 1) > 148 Then
        n = n + 1
        For j = 1 To 3: tablo(n, j) = tablo(i, j): Next
    End If
Next
If n Then F.[A2].Resize(n, 3) = tablo
F.Visible = xlSheetVisible 'si la feuille est masquée
Application.Goto F.[A1], True 'cadrage
MsgBox Format(Timer - t, "0.00 \sec")
End Sub

A+

 

[Usine à gaz]

Bonsoir Job,

Merci d'être encore là.
Je vais tenter de comprendre.
Bonne fin de soirée,
Amicalement,
Lionel

 

[Usine à gaz]

Bonjour à toutes et à tous,

Encore un grand merci job75 et à zebanx,

Le code et les variantes que j'ai pu adapter fonctionnent super bien mais voilà .... LOL
J'ai un nouveau besoin que je n'avais pas prévu et je n'arrive pas malgré mes essais et recherches à trouver le bon code
Ce que je voudrais faire :
J'aimerais pouvoir copier les cellules qui contiennent dans leur texte certains mots.
Par exemple le mot "comment" (ou plusieurs mots)
Pour ça, j'ai trouvé le bon code : If tablo(i, 1) Like "comment" Then

Toutefois, à chaque mot nouveau, ce ne serait pas pratique de devoir changer le mot ou chaine de mots dans le code et je souhaiterais faire référence à une cellule de la feuille ou d'une autre feuille
If tablo(i, 1) Like "=[j1]" Then (ou d'une autre feuille)
Évidemment ça ne fonctionne pas

Dans le fichier test joint je voudrai faire référence à la cellule J1 de la Feuil1 ou de la Feuil2

Pourriez-vous m'aider encore une fois.

Un très grand merci par avance
Bonne fin de journée à toutes et à tous,
Amicalement,
Arthour973,

 

[zebanx]

Salut Arthour973

Tu as l'air bien lancé.
Essaye peut-être avec If tablo(i, 1) Like "*" & [J1] & "*" Then...

@+

 

[Usine à gaz]

Bonsoir Zebanx,

Merci pour ta réponse et le "Tu as l'air bien lancé" LOL"

Je teste et je reviens

 

[Usine à gaz]

Re-Zebanx,

ça marche nickel
Encore un grand merci à toi
Amicalement,
Arthour973,

 

[job75]

Bonsoir Lionel, zebanx,

Je ne comprends pas, c'est du niveau débutant :

Sub Copie_tableau_job75_origine()
Dim F As Worksheet, critere$, tablo, i&, n&, j%, t0
t0 = Timer
Set F = Feuil2 'CodeName de la feuille de destination
F.Range("A2:F" & F.Rows.Count).Delete 'RAZ
critere = F.[j1] 'ou Feuil1.[j1]
tablo = Feuil1.UsedRange.Resize(, 4) 'matrice, plus rapide
For i = 2 To UBound(tablo)
    If tablo(i, 1) Like critere Then
        n = n + 1
        For j = 1 To 4: tablo(n, j) = tablo(i, j): Next
    End If
Next
If n Then F.[a2].Resize(n, 4) = tablo
'F.Columns.AutoFit 'ajustement largeurs
F.Visible = xlSheetVisible 'si la feuille est masquée
Application.Goto F.[A1], True 'cadrage
MsgBox Format(Timer - t0, "0.000_sec")
End Sub

Il sera bien de mettre une liste de validation en J1.

A+

 

[Usine à gaz]

Bonsoir Job75,
Merci encore une fois d'être là
OUI bien sûr, il y a bcp de choses que j'ai pu apprendre à faire grâce à toi et aux intervenants du forum ....
Mais je suis toujours débutant et "bricoleur".
Tjours grâce à vous, j'arrive à adapter des codes mais il y a tellement de choses que je ne connais pas encore et "critere = F.[j1] 'ou Feuil1.[j1]" et je n'aurais pas pu le trouver

Merci Job, bonne fin de journée,
Amicalement,
Lionel,

 

[job75]

il y a tellement de choses que je ne connais pas encore et "critere = F.[j1] 'ou Feuil1.[j1]" et je n'aurais pas pu le trouver

Mettre la valeur d'une cellule dans une variable c'est le B A BA, ici cela permet d'aller plus vite dans la boucle.

 

[zebanx]

Bonsoir Job75

Très bonne idée la liste déroulante. Plus l'habitude d'utiliser un array mais c'est une bonne solution, merci de l'avoir indiqué.

@+