Simplifier code VBA
bonjour
je voudrais simplifier ce code pour éviter la redondance (et apprendre) en ne détaillant pas à chaque fois le code en relation avec la feuille source
voici le code initial ou il y a 3 feuilles sources "CO A", "CO B", "CO C"
Sub CopierLigne()
Dim Lig As Long, Col As String
Dim NbrLig As Long, NumLig As Long
' Feuille de destination
Sheets("remplacement").Activate
' Colonne des données à tester
Col = "E"
' le n° de la 1ère ligne de données de destination
NumLig = 8
With Sheets("CO A") 'feuille source
NbrLig = .Cells(65536, Col).End(xlUp).Row
For Lig = 9 To NbrLig Step 2
If .Cells(Lig, Col).Value = "géré" Or .Cells(Lig, Col).Value = "à suivre" Or .Cells(Lig, Col).Value = "à prévoir" Then
.Rows(Lig & ":" & Lig + 1).EntireRow.Copy Destination:=Sheets("Remplacement").Cells(NumLig, 1)
NumLig = NumLig + 2
End If
Next
End With
With Sheets("CO B") 'feuille source
NbrLig = .Cells(65536, Col).End(xlUp).Row
For Lig = 9 To NbrLig Step 2
If .Cells(Lig, Col).Value = "géré" Or .Cells(Lig, Col).Value = "à suivre" Or .Cells(Lig, Col).Value = "à prévoir" Then
.Rows(Lig & ":" & Lig + 1).EntireRow.Copy Destination:=Sheets("Remplacement").Cells(NumLig, 1)
NumLig = NumLig + 2
End If
Next
End With
With Sheets("CO C") 'feuille source
NbrLig = .Cells(65536, Col).End(xlUp).Row
For Lig = 9 To NbrLig Step 2
If .Cells(Lig, Col).Value = "géré" Or .Cells(Lig, Col).Value = "à suivre" Or .Cells(Lig, Col).Value = "à prévoir" Then
.Rows(Lig & ":" & Lig + 1).EntireRow.Copy Destination:=Sheets("Remplacement").Cells(NumLig, 1)
NumLig = NumLig + 2
End If
Next
End With
End Sub
j'ai essayé de le remplacer par mais bug et le débogage ne m'aide pas
Sub CopierLigne()
Dim Lig As Long, Col As String
Dim NbrLig As Long, NumLig As Long
' Feuille de destination
Sheets("remplacement").Activate
' Colonne des données à tester
Col = "E"
' le n° de la 1ère ligne de données de destination
NumLig = 8
Dim Ws As Worksheet
Application.ScreenUpdating = False
For Each Ws In Sheets(Array("CO A", "CO B", "CO C"))
With Ws
NbrLig = .Cells(65536, Col).End(xlUp).Row
For Lig = 9 To NbrLig Step 2
If .Cells(Lig, Col).Value = "géré" Or .Cells(Lig, Col).Value = "à suivre" Or .Cells(Lig, Col).Value = "à prévoir" Then
.Rows(Lig & ":" & Lig + 1).EntireRow.Copy Destination:=Sheets("Remplacement").Cells(NumLig, 1)
NumLig = NumLig + 2
End If
Next
End With
End Sub
merci de votre aide
Bonjour,
un exemple :
Sub boucleSh()
Dim listeF, sh As Worksheet
listeF = Array("Feuil1", "Feuil2", "Feuil3")
For Each sh In Sheets(listeF)
With sh
.Select
MsgBox "Feuille active : " & .Name
End With
Next sh
End Sub
eric
merci Eric
pour cette réponse
je vais essayé de l'inclure dans le premier code
et ainsi appliquer votre devise des shaddocks
bonne journée