Insertion fonction If dans un module VBA

Question

Bonjour à tous.

J'ai créé une macro qui permet de copier les valeurs de certaines cellules dans une autre feuille :

Private Sub Copier_click()

Dim WsC As Worksheet
Dim DerLigC As Long, DerLigS As Long

Application.ScreenUpdating = False
Set WsC = Worksheets("Amalgame")
With Worksheets("Générateur BCI")
DerLigS = .Range("Fond").End(xlUp).Row
For i = 16 To DerLigS
DerLigC = WsC.Range("D" & Rows.Count).End(xlUp).Row + 1
WsC.Range("G" & DerLigC) = .Range("B3") 'N° bon de commande interne
WsC.Range("A" & DerLigC) = .Range("P2") 'Date du jour
WsC.Range("D" & DerLigC) = .Range("B5") ' Bâtiment
WsC.Range("H" & DerLigC) = Range("D5") 'Demandeur
WsC.Range("E" & DerLigC) = .Range("D3") 'Service
WsC.Range("F" & DerLigC) = .Range("D4") 'Etage
WsC.Range("B" & DerLigC) = .Range("A" & i) 'N° article
WsC.Range("C" & DerLigC) = .Range("C" & i) 'Quantité

Next i
End With
WsC.Activate
Set WsC = Nothing

End Sub

La macro fonctionne parfaitement mais j'aimerai pouvoir copier les données uniquement si la valeur de la cellule H4 est égale à OUI. J'ai pensé à insérer le code suivant :

If Range("H4").Value="OUI"
End If

J'ai testé mais cela ne fonctionne pas (voir module 5 dans le fichier en annexe)... Faut-il insérer le code à un endroit précis ?

9fichier-test.xlsm (100.43 Ko)

Bien cordialement,

Huggy.

BAROUTE78 · Accepted Answer

Et ca ?

Private Sub Copier_click()
Dim WsC As Worksheet
Dim DerLigC As Long, DerLigS As Long
Application.ScreenUpdating = False

With Worksheets("Générateur BCI")

If .Range("H4") = "OUI" Then 

Set WsC = Worksheets("Amalgame")

DerLigS = .Range("Fond").End(xlUp).Row
For i = 16 To DerLigS
DerLigC = WsC.Range("D" & Rows.Count).End(xlUp).Row + 1
WsC.Range("G" & DerLigC) = .Range("B3") 'N° bon de commande interne
WsC.Range("A" & DerLigC) = .Range("P2") 'Date du jour
WsC.Range("D" & DerLigC) = .Range("B5") ' Bâtiment
WsC.Range("H" & DerLigC) = Range("D5") 'Demandeur
WsC.Range("E" & DerLigC) = .Range("D3") 'Service
WsC.Range("F" & DerLigC) = .Range("D4") 'Etage
WsC.Range("B" & DerLigC) = .Range("A" & i) 'N° article
WsC.Range("C" & DerLigC) = .Range("C" & i) 'Quantité

Next i

WsC.Activate
Set WsC = Nothing

Else

End If

End With
Application.ScreenUpdating = True
End Sub

@+

BAROUTE78 · Answer

Essaie : If Range("H4") = "OUI" Then TonCode Else End if @+...

BAROUTE78 · Answer

Ce n'est pas ce que j'ai expliqué ... Essaie ça : Private Sub Copier_click() Dim WsC As Worksheet Dim DerLigC As Long, DerLigS As Long Application.ScreenUpdating = False If .Range("H4") = "OUI" Then Set WsC = Worksheets("Amalgame") With Worksheets("Générateur BCI") DerLigS = .Range("Fond").End(xlUp).Row For i = 16 To DerLigS DerLigC = WsC.Range("D" & Rows.Count).End(xlUp).Row + 1 WsC.Range("G" & DerLigC) = .Range("B3") 'N° bon de commande interne WsC.Range("A" & DerLigC) = .Range("P2") 'Date du jour WsC.Range("D" & DerLigC) = .Range("B5") ' Bâtiment WsC.Range("H" & DerLigC) = Range("D5") 'Demandeur WsC.Range("E" & DerLigC) = .Range("D3") 'Service WsC.Range("F" & DerLigC) = .Range("D4") 'Etage WsC.Range("B" & DerLigC) = .Range("A" & i) 'N° article WsC.Range("C" & DerLigC) = .Range("C" & i) 'Quantité Next i End With WsC.Activate Set WsC = Nothing Else End If Application.ScreenUpdating = True End Sub @+...