Copie de ligne de différentes feuilles vers une feuille unique en 1 macro ?

Bonjour,

Tu copies ce qui suit dans un module standard :
Il est tenu pour acquis que la première ligne (ligne 1) est réservée
aux étiquettes de colonnes.

P.S. Attention aux lignes de code coupées par le service de messagerie

Tu n'exécutes que la macro générale :
'--------------------------------------------------------------
Sub Macro_Generale()
Dim ModCalcul As String
ModCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False
Call Macro1
Call Macro2
Application.EnableEvents = True
Application.Calculation = ModCalcul
Application.ScreenUpdating = True
End Sub
'--------------------------------------------------------------

Private Sub Macro1()
Dim Rg As Range, Elt As Variant, Arr()

'Tu entres tous les codes que tu veux
'pour la feuille BCT
Arr = Array("CDN", "CDNE", "CDNS")

With Workbooks("Essai.xls")
For Each Elt In Arr
With .Worksheets("BCT")
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
.AutoFilter field:=1, Criteria1:=Elt
With .Range("_FilterDataBase")
Set Rg = .Offset(1).Resize(.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible)
End With
End With
End With
With Sheets("Donnees")
Rg.EntireRow.Copy .Range("A" & .Range("A65536").End(xlUp)(2).Row)
Rg.AutoFilter
End With
Next
End With
End Sub
'--------------------------------------------------------------
Private Sub Macro2()
Dim Rg As Range, Elt As Variant, Arr()

'Tu entres tous les codes que tu veux
'pour la feuille OBC
Arr = Array("OBC")

With Workbooks("Essai.xls")
For Each Elt In Arr
With .Worksheets("OBC")
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
.AutoFilter field:=1, Criteria1:=Elt
With .Range("_FilterDataBase")
Set Rg = .Offset(1).Resize(.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible)
End With
End With
End With
With Sheets("Donnees")
Rg.EntireRow.Copy .Range("A" & .Range("A65536").End(xlUp)(2).Row)
Rg.AutoFilter
End With
Next
End With
End Sub
'--------------------------------------------------------------


MichD
--------------------------------------------


"stormtroopertk1230" a écrit dans le message de groupe de discussion : jv2dnS5BGdO6voTQRVn_vwA@giganews.com...

Bonjour,

j'ai 2 macros qui font la même chose, elles récupèrent des lignes dont les
valeurs de la colonne A sont soient CDN de la feuille BCT soit OBC de la feuille
OBC.
Je voudrai savoir s'il est possible de ne faire qu'une seule macro sachant que
les codifications vont aussi être multiples par feuille. Par exemple, Il y aura
du CDNE & CDNS pour la feuille BCT.
Merci de votre retour.

Sub Macro1()
Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long

Sheets("Donnees").Activate ' feuille de destination


Col = "A" ' colonne de la donnée non vide à tester
NumLig = 1
With Workbooks("Essai.xls").Worksheets("BCT") ' feuille source
NbrLig = .Cells(300, Col).End(xlUp).Row
For Lig = 1 To NbrLig

If .Cells(Lig, Col).Value = "CDN" Then
Cells(Lig, Col).EntireRow.Copy


NumLig = NumLig + 1
Cells(NumLig, 1).Select
ActiveSheet.Paste


End If
Next
End With

End Sub

Sub Macro2()
Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long

Sheets("Donnees").Activate ' feuille de destination


Col = "A" ' colonne de la donnée non vide à tester
NumLig = 1
With Workbooks("Essai.xls").Worksheets("OBC") ' feuille source
NbrLig = .Cells(300, Col).End(xlDown).Row
For Lig = 1 To NbrLig

If .Cells(Lig, Col).Value = "OBC" Then
Cells(Lig, Col).EntireRow.Copy

NumLig = NumLig + 1
Sheets("Donnees").Range("A2", Selection.End(xlDown)).Cells(NumLig, 1).Insert
Shift:=xlDown
'Sheets("Donnees").Cells(NumLig, 1).Insert Shift:=xlUp '

End If
Next
End With

End Sub