INFINITY100
XLDnaute Occasionnel
Bonjour à tous
Voila je viens vers vous afin de trouver une petit aide concernant mon petit soucis VBA, en effet j'ai une macro qui fonctionne à merveille qui copie des informations de la feuille nommée "Source" vers la feuille nommée "CFA" jusque là tout va bien
Seulement je voudrai ajouter au code ci-dessous une condition afin d'avoir un résultat qui soit si la cellule A1 de la feuille nommée "Source" contient le terme UREA tu me copie dans les informations dans la feuille UREA et si la cellule A1 de la feuille nommée "Source" aussi contient le terme UFI alors tu me copie les informations dans la feuille UFI
Voici mon code en question :
Je joins le fichier pour être plus explicite
merci à vous tous
Cordialement
Voila je viens vers vous afin de trouver une petit aide concernant mon petit soucis VBA, en effet j'ai une macro qui fonctionne à merveille qui copie des informations de la feuille nommée "Source" vers la feuille nommée "CFA" jusque là tout va bien
Seulement je voudrai ajouter au code ci-dessous une condition afin d'avoir un résultat qui soit si la cellule A1 de la feuille nommée "Source" contient le terme UREA tu me copie dans les informations dans la feuille UREA et si la cellule A1 de la feuille nommée "Source" aussi contient le terme UFI alors tu me copie les informations dans la feuille UFI
Voici mon code en question :
VB:
'Variables utilisées dans la macro.
Dim DernierID As Integer
Dim LigneVide As Integer
Sub Copier_Coller()
'Selectionner les cellules à copier
Sheets("Source").Range("B2:B9").Copy
'Recherche du numero de l'ID de la dernière ligne renseignée + 1
With Sheets("CFA")
DernierID = WorksheetFunction.Max(Sheets("CFA").Range("A:A"))
LigneVide = Sheets("CFA").Range("A" & Rows.Count).End(xlUp).Row + 1
If LigneVide < 2 Then LigneVide = 2
'Ecrire le nouveau N° dans la dite feuille (CFA)
Sheets("CFA").Range("A" & LigneVide) = DernierID + 1
'Effectuer la copie vers la feuille (CFA)
With Sheets("CFA").Range("b65536").End(xlUp)(2)
.PasteSpecial Paste:=xlValues, Transpose:=True
.HorizontalAlignment = xlCenter
End With
Application.CutCopyMode = False
End With
Application.ScreenUpdating = True
End SubJe joins le fichier pour être plus explicite
merci à vous tous
Cordialement