[VBA] Rechercher et copier une plage

Z

Zaffe

XLDnaute Nouveau
Bonjour le forum,

Même si je pensais pouvoir me débrouiller seul j'ai finalement un peu de mal à résoudre mon problème seul, je ne suis pas assez perfectionner en VBA :(
Je souhaite rechercher sur 2 onglets toute ligne correspondant au numéro entrer dans la textebox et copier les plages, correspondante à ces lignes, sur la feuille recherche.

Si quelqu'un passe par la et a une solution je suis preneur.

Merci
 

Pièces jointes

  • Classeur.xls
    28.5 KB · Affichages: 139
  • Classeur.xls
    28.5 KB · Affichages: 141
  • Classeur.xls
    28.5 KB · Affichages: 125
Trier par date Trier par votes
M

Minick

XLDnaute Impliqué
Re : [VBA] Rechercher et copier une plage

Salut,

Tu peux essayer comme cela:
Code: 
Private Sub CommandButton2_Click()
    Dim BD As Variant
    Dim CptBD As Byte
    
    BD = Array("BD1", "BD2")
    
    Sheets("Recherche").Range("A6:C" & Sheets("Recherche").Range("A6").End(xlDown).Row).ClearContents
    For CptBD = 0 To UBound(BD)
        With Sheets(BD(CptBD))
            .Range("A1:I" & .Range("A65536").End(xlUp).Row).AutoFilter Field:=1, Criteria1:=Sheets("Recherche").TextBox1.Text
            
            If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
                .Range("G2:I" & .Range("A65536").End(xlUp).Row).Copy
                Sheets("Recherche").Range("A" & Sheets("Recherche").Range("A65536").End(xlUp).Row + 1).PasteSpecial xlPasteValues
                Application.CutCopyMode = False
            End If
            .AutoFilterMode = False
        End With
    Next CptBD
End Sub
 
Vote positif 0 Vote négatif
youky(BJ)

youky(BJ)

XLDnaute Barbatruc
Re : [VBA] Rechercher et copier une plage

Bonjour Zaff,
Voici un code, Nombre de BD non limité
Seuls les onglets commencant par BD sont pris en compte.
Bruno

Code: 
Private Sub CommandButton2_Click()
lig = 6
[A6:C36].ClearContents
For onglet = 1 To Sheets.Count
If Left(Sheets(onglet).Name, 2) = "BD" Then
With Sheets(onglet)
For Each c In .Range("A2:A" & .[A65536].End(3).Row)
If Val(Sheets("Recherche").TextBox1.Value) = c.Value Then
Sheets("Recherche").Range("A" & lig & ":C" & lig).Value = _
.Range("G" & c.Row & ":I" & c.Row).Value
lig = lig + 1
End If
Next
End With
End If
Next
End Sub
 
Vote positif 0 Vote négatif
Z

Zaffe

XLDnaute Nouveau
Re : [VBA] Rechercher et copier une plage

Merci à vous deux pour vos codes, je vais essayer de les utiliser.

(Caluire et son bon vieux métro C, ca me manque tout ca :()

Edit : Après adaptation ca fonctionne très bien, todo esta muy bien ! Encore merci à vous 2
 
Dernière édition:
Vote positif 0 Vote négatif
Z

Zaffe

XLDnaute Nouveau
Re : [VBA] Rechercher et copier une plage

Avec un fichier excel de plus de 250 Mo, on va dire que excel à un peu de mal à répondre à mes demandes :D (ex: enregistrement => 1mn; macro => 2mn)...
Vous pensez qu'en créant 2 classeurs (1 avec les BD1, 2, 3...; et l'autre avec le reste) ca peut accélerer le tout ? Dans ce cas la ou dois-je mettre "With WorkBood dans le code ?
Merci d'avance :eek:
 
Vote positif 0 Vote négatif
jeanpierre

jeanpierre

Nous a quitté
Repose en paix
Re : [VBA] Rechercher et copier une plage

Bonjour Zaffe, Bruno, Minick,

Pfiou, 250Mo.... (normal que cela ne réponde pas et c'est moins lié à Excel qu'à la machine)

J'ai eu quelques fichiers assez énormes entre 13 et 19Mo, mais 250... ???

Je ne sais pas si la création de 2 fichiers distincts vont résoudre ton problème, j'ai l'impression que non...

Petite impression au passage.

Jean-Pierre
 
Vote positif 0 Vote négatif
M

Minick

XLDnaute Impliqué
Re : [VBA] Rechercher et copier une plage

Salut,

Wahouuu, effectivement 250Mo j'ai jamais vu ca, pourtant j'ai vu passe pas mal de chose...

Je ne sais pas d'ou vient ta source de donnees (BD1, etc...) mais as-tu envisage de gerer cela dans une base de donnees type access?
 
Vote positif 0 Vote négatif
Z

Zaffe

XLDnaute Nouveau
Re : [VBA] Rechercher et copier une plage

Je me posais justement la question, mais me replonger dans l'univers Access et continuer à progresser en VBA ca risque d'être dur :D.

Je me disais qu'en me débarassant des bases (4 onglets de 65000 lignes et 30 colonnes = :eek:) qui fait à lui seul 99% du poid ca pourrait aller car jusqu'a là je n'ai pas eu trop de ralentissement sauf lors de la sauvergarde.

Ce dernier code est très rapide car en quelques secondes tout y est sauf que quand j'ai voulu le "doubler" avec le code ci dessous il a était moins performant (2 minutes pour me copier 50 lignes contre 3 secondes pour en copier 25)

Sheets("Données Graphique").Range("A" & lig & ":H" & lig).Value = _
.Range("BB" & c.Row & ":BI" & c.Row).Value
Sheets("Données Graphique").Range("J" & lig & ":AI" & lig).Value = _
.Range("BL" & c.Row & ":CK" & c.Row).Value
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
Z

Zaffe

XLDnaute Nouveau
Re : [VBA] Rechercher et copier une plage

Minick à dit:
Salut,

Wahouuu, effectivement 250Mo j'ai jamais vu ca, pourtant j'ai vu passe pas mal de chose...

Je ne sais pas d'ou vient ta source de donnees (BD1, etc...) mais as-tu envisage de gerer cela dans une base de donnees type access?
Cliquez pour agrandir...

Enfaite c'est un suivi des clients par semaine depuis 2009 avec la façon dont est passé les commandes... du coup ca en fait des lignes :D
 
Vote positif 0 Vote négatif
Z

Zaffe

XLDnaute Nouveau
Re : [VBA] Rechercher et copier une plage

Minick à dit:
AS-tu essaye avec la methode du filtre (celle du code que je t'ai propose)?
Tu gagneras peut etre quelques precieuses secondes.
Cliquez pour agrandir...

Pour faire deux copies il suffit de dupliquer les lignes ? :D Je dois copier BB à BI et de BL à CK
pour coller de C à H et de L à AI.


Private Sub CommandButton1_Click()
Dim BD As Variant
Dim CptBD As Byte

BD = Array("BD1", "BD2"; "BD3"; "BD4")

Sheets("Données Graphique").Range("A6:AI" & Sheets("Données Graphique").Range("A6").End(xlDown).Row).ClearContents
For CptBD = 0 To UBound(BD)
With Sheets(BD(CptBD))
.Range("A1:A" & .Range("A65536").End(xlUp).Row).AutoFilter Field:=1, Criteria1:=Sheets("Données Graphique").TextBox2.Text

If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
.Range("BB2:BI" & .Range("BB65536").End(xlUp).Row).Copy
Sheets("Données Graphique").Range("C" & Sheets("Données Graphique").Range("C65536").End(xlUp).Row + 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
.AutoFilterMode = False
End With
Next CptBD
End Sub
Cliquez pour agrandir...
 
Dernière édition:
Vote positif 0 Vote négatif
M

Minick

XLDnaute Impliqué
Re : [VBA] Rechercher et copier une plage

Salut,

Presque, il faut bien copier 2 fois mais avant, memoriser la ligne de destination
pour ne pas decaler le collage

Code: 
Private Sub CommandButton2_Click()
    Dim BD As Variant
    Dim CptBD As Byte
    Dim LigDst As Long
    BD = Array("BD1", "BD2", "BD3", "BD4")
    
    Sheets("Données Graphique").Range("C6:AI" & Sheets("Données Graphique").Range("C6").End(xlDown).Row).ClearContents
    For CptBD = 0 To UBound(BD)
        With Sheets(BD(CptBD))
            .Range("A1:A" & .Range("A65536").End(xlUp).Row).AutoFilter Field:=1, Criteria1:=Sheets("Données Graphique").TextBox1.Text
            
            If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
                LigDst = Sheets("Données Graphique").Range("C65536").End(xlUp).Row + 1
                .Range("BB2:BI" & .Range("BB65536").End(xlUp).Row).Copy
                Sheets("Données Graphique").Range("C" & LigDst).PasteSpecial xlPasteValues
                .Range("BL2:CK" & .Range("BL65536").End(xlUp).Row).Copy
                Sheets("Données Graphique").Range("L" & LigDst).PasteSpecial xlPasteValues
                Application.CutCopyMode = False
            End If
            .AutoFilterMode = False
        End With
    Next CptBD
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
MJ13

MJ13

XLDnaute Barbatruc
Re : [VBA] Rechercher et copier une plage

Bonjour à tous


Zaffe: Quand je lis cela:

Je me disais qu'en me débarassant des bases (4 onglets de 65000 lignes et 30 colonnes = :eek:) qui fait à lui seul 99% du poid ca pourrait aller car jusqu'a là je n'ai pas eu trop de ralentissement sauf lors de la sauvergarde.
Cliquez pour agrandir...

Je pense que la solution idéale est dans ce cas travailler sur des fichiers de type txt, csv, voire xls puis faire des requêtes de type ODBC.

De toute façon, travailler sur un fichier de 250 Mo avec Excel, ce n'est pas très sérieux.
 
Vote positif 0 Vote négatif
Z

Zaffe

XLDnaute Nouveau
Re : [VBA] Rechercher et copier une plage

Minick à dit:
Salut,

Presque, il faut bien copier 2 fois mais avant, memoriser la ligne de destination
pour ne pas decaler le collage

Code: 
Private Sub CommandButton2_Click()
    Dim BD As Variant
    Dim CptBD As Byte
    Dim LigDst As Long
    BD = Array("BD1", "BD2", "BD3", "BD4")
    
    Sheets("Données Graphique").Range("C6:AI" & Sheets("Données Graphique").Range("C6").End(xlDown).Row).ClearContents
    For CptBD = 0 To UBound(BD)
        With Sheets(BD(CptBD))
            .Range("A1:A" & .Range("A65536").End(xlUp).Row).AutoFilter Field:=1, Criteria1:=Sheets("Données Graphique").TextBox1.Text
            
            If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
                LigDst = Sheets("Données Graphique").Range("C65536").End(xlUp).Row + 1
                .Range("BB2:BI" & .Range("BB65536").End(xlUp).Row).Copy
                Sheets("Données Graphique").Range("C" & LigDst).PasteSpecial xlPasteValues
                .Range("BL2:CK" & .Range("BL65536").End(xlUp).Row).Copy
                Sheets("Données Graphique").Range("L" & LigDst).PasteSpecial xlPasteValues
                Application.CutCopyMode = False
            End If
            .AutoFilterMode = False
        End With
    Next CptBD
End Sub
Cliquez pour agrandir...

Bonjour MiniCK,

Je viens d'essayer ton code, j'ai eu une première erreur et j'ai rapidement compris qu'il me manquait un onglet (BD4) par contre la j'ai une deuxième erreur et je ne trouve pas ou est le problème : "La méthode autofilter de la classe Ranger à échouer"
Tu ne sais pas par hasard a quoi cela peut être du ?
 
Vote positif 0 Vote négatif

Discussions similaires

D
  • Résolu(e)
Microsoft 365 Copier coller données Excel avec recherche
Réponses
5
Affichages
297
Derrdio
D
N
  • Résolu(e)
Microsoft 365 Fonction Find.Range
Réponses
12
Affichages
514
Staple1600
Staple1600
S
  • Résolu(e)
Autres Copier-Coller en recherchant une ligne spécifique VBA
Réponses
4
Affichages
276
sambio2
S
R
  • Question
Microsoft 365 actualisation cube olap et vba
Réponses
4
Affichages
188
Dudu2
Dudu2
D
  • Question
XL 2016 VBA - Copier/coller valeur d'une cellule, sur une plage de cellule données.
2 3
Réponses
34
Affichages
824
DaONE
D
DAVID-44-
  • Question
XL 2010 Intégrer l'outil "rechercher et remplacer" dans une cellule.
Réponses
14
Affichages
442
DAVID-44-
DAVID-44-
D
  • Résolu(e)
Microsoft 365 TRIER SUR FEUILLE PROTEGER
Réponses
8
Affichages
138
dd_76
D
B
  • Question
XL 2016 recherche dans une colonne depuis un autre onglet
Réponses
5
Affichages
129
boguinette
B
G
  • Résolu(e)
Copie de données d'une feuille à une autre
Réponses
2
Affichages
180
gui22
G
Sellig
  • Question
XL 2019 Insertion de plusieurs lignes au dessus de la dernière
Réponses
2
Affichages
268
Sellig
Sellig

Membres actuellement en ligne

22 membres et 395 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 094
Messages
2 085 244
Membres
102 833
dernier inscrit
Hassna