XL 2013 transfert de ligne vers autre feuille

[gena]

BONJOUR LE FORUM

je recherche par un macro comment copier des lignes qui aurais un X en colonne O et qui serais copier dans la feuille résultats

mais sans effacer celle de la base de données global

avec tout mes remerciements

 

[Optimal]

Bonsoir gena

Code à copier dans un module.

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

 

[gena]

merci infiniment affaire résolut

 

[Optimal]

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

Content d'avoir pu vous aider modestement

 

[Staple1600]

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.

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

 

[Optimal]

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

 

[Staple1600]

Re

=>Optimal
Un Viandox on the rocks

 

[gena]

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

 

[Staple1600]

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

 

[gena]

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

 

[Staple1600]

Re

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

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

 

[gena]

oula celui merci infiniment je prend

 

[job75]

Bonjour gena, JM (heureux de te revoir),

Comme je l'ai fait, je le poste :

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+

 

[gena]

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

 

[Staple1600]

Re

=>gena
Une dernière modification

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?