XL 2013 transfert de ligne vers autre feuille

gena

XLDnaute Occasionnel
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
 

Pièces jointes

  • essaie ligne x.xlsm
    436.7 KB · Affichages: 30
Solution
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

Optimal

XLDnaute Junior
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
 

Staple1600

XLDnaute Barbatruc
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
 

Staple1600

XLDnaute Barbatruc
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
 

job75

XLDnaute Barbatruc
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

Staple1600

XLDnaute Barbatruc
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?
 

Discussions similaires

Réponses
14
Affichages
294
Réponses
7
Affichages
626
Réponses
3
Affichages
310

Statistiques des forums

Discussions
314 450
Messages
2 109 726
Membres
110 552
dernier inscrit
jasson