XL 2013 transfert de ligne vers autre feuille

O

Optimal

XLDnaute Junior

• 15 Août 2020

• #2

Bonsoir gena

Code à copier dans un module.

VB:

Sub Copie_Ligne()
  Dim Lig     As Long
  Dim Col     As String
  Dim NbrLig  As Long
  Dim NumLig  As Long
 
  Sheets("BaseDeDonnéesGlobal").Activate
 
  Col = "o"
  NumLig = 2
  With Sheets("BaseDeDonnéesGlobal")
  NbrLig = .Cells(65536, Col).End(xlUp).Row
  For Lig = 3 To NbrLig
    If .Cells(Lig, Col).Value = "X" Then
      .Cells(Lig, Col).EntireRow.Copy
      NumLig = NumLig + 1
      Sheets("resultats").Cells(NumLig, 1).Insert Shift:=xlDown
          
    End If
  Next
  End With
End Sub

 

Vote positif 0 Vote négatif

Solution

G

gena

XLDnaute Occasionnel

• 15 Août 2020

• #3

merci infiniment affaire résolut

 

Vote positif 0 Vote négatif

O

Optimal

XLDnaute Junior

• 15 Août 2020

• #4

Ah ben pour une fois que j'arrive à aider quelqu'un ! ça s'arrose ça ! 🙂

Content d'avoir pu vous aider modestement

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 15 Août 2020

• #5

Bonsoir le fil

Puisqu'on parle apéritif 😉
Une autre voie possible (histoire de varier les plaisirs)
NB: Il faudra faire quelques adaptations.
Notamment la plage de cellules à filtrer.

VB:

Sub Macro1()
Dim f As Worksheet: Set f = ActiveSheet ' à adapter
f.Range("$A$1:$O$25").AutoFilter Field:=15, Criteria1:="X"
f.AutoFilter.Range.Offset(1, 0).Copy Sheets("Résultats").Cells(Rows.Count, 1).End(xlUp)(2)
f.ShowAllData
End Sub

 

Vote positif 0 Vote négatif

O

Optimal

XLDnaute Junior

• 15 Août 2020

• #6

Héhé ! Bon dès qu'on parle d'apéro hein !
Alors je vous sert quoi donc ?

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 15 Août 2020

• #7

Re

=>Optimal
Un Viandox on the rocks 😉

 

Vote positif 0 Vote négatif

G

gena

XLDnaute Occasionnel

• 15 Août 2020

• #8

merci stape pour votre aide
mais voila cela garde bien mes lignes avec un X dans sa totalité mais éfface tout le reste dans ma base de données global et transfère pas dans onglet résultats

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 15 Août 2020

• #9

Re

Comme je le disais, il faut faire quelques adaptations.
(voir les commentaires dans le code)
J'ai testé avant de poster mon bout de code VBA.

Sinon, puisque la solution d'Optimal fonctionne comme tu souhaites, ne gardes qu'elle 😉

 

Vote positif 0 Vote négatif

G

gena

XLDnaute Occasionnel

• 15 Août 2020

• #10

NON je suis la pour apprendre alors je regarde cela de plus prés pour comprendre votre codage et changé si je doit
encore merci infiniment

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 15 Août 2020

• #11

Re

Alors voici une première adaptation.
(je te laisse trouver ce qui change d'avec la macro 1)

VB:

Sub Macro2()
Dim f As Worksheet: Set f = Sheets("BaseDeDonnéesGlobal")
f.Range("$A$1:$O$25").AutoFilter Field:=15, Criteria1:="X"
'reste ici la plage de cellules à adapter
f.AutoFilter.Range.Offset(1, 0).Copy Sheets("Résultats").Cells(Rows.Count, 1).End(xlUp)(2)
f.ShowAllData
End Sub

 

Vote positif 0 Vote négatif

G

gena

XLDnaute Occasionnel

• 15 Août 2020

• #12

oula celui merci infiniment je prend

 

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 15 Août 2020

• #13

Bonjour gena, JM (heureux de te revoir),

Comme je l'ai fait, je le poste :

VB:

Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Cells.Delete 'RAZ
With [Tableau1].ListObject.Range 'tableau structuré
    .AutoFilter 15, "X"
    .SpecialCells(xlCellTypeVisible).Copy [A1]
    .AutoFilter
End With
Rows(1).RowHeight = 45
Columns.AutoFit 'ajustement largeur
End Sub

A+

 

Pièces jointes

• essaie ligne x.xlsm

  442 KB · Affichages: 4

Vote positif 0 Vote négatif

G

gena

XLDnaute Occasionnel

• 15 Août 2020

• #14

moi aussi job tout le monde va bien ???????
tu poste quoi
Comme je l'ai fait, je le poste :

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 15 Août 2020

• #15

Re

=>gena
Une dernière modification

VB:

Sub Macro3()
Dim f As Worksheet: Set f = Sheets("BaseDeDonnéesGlobal")
f.Cells(1).CurrentRegion.AutoFilter 15, "X"
f.AutoFilter.Range.Offset(1, 0).Copy Sheets("Résultats").Cells(Rows.Count, 1).End(xlUp)(2)
f.ShowAllData
End Sub

Cela fonctionne sur mon fichier de test.
Et toi?

 

Vote positif 0 Vote négatif