Bonjour a tous,
J'utilise un fichier excel pour effectuer le suivi d'action d'un projet et j'aimerais modifier une macro déja existante (que je n'ai pas codée) pour réaliser différentes archives en fonction des valeurs d'une des listses déroulantes de ce fichier.
La macro déja réalisée permet de créer une archive globale qui reprend toutes les lignes du fichier et une archive "conditionnelle" qui n'archive que les lignes du fichier qui contiennent le mot toto dans la liste déroulante. Je voudrais donc modifier cette macro pour effectuer 2 archivages supplémentaires qui ne reprendrait que les lignes du fichier qui contiennent toti et tata dans la liste déroulante.
Voici le code de la macro.
Sub ArchiveAMo()
'
' Touche de raccourci du clavier: Ctrl+Maj+A
'
Dim WorkbookSave As Excel.Workbook
Dim question As Integer
question = MsgBox("Are you sure you want to archive the Project Log?" & vbCr & _
"All unsaved changes will be lost.", vbYesNo + vbDefaultButton2 + vbExclamation, "Archiving confirmation")
If question = 6 Then
Worksheets("Opened Actions").Activate
Set c = Worksheets("Opened Actions").Columns("A").Find("", LookIn:=xlValues)
If Not c Is Nothing Then
Worksheets("Opened Actions").AutoFilterMode = False
targetRow = c.Row - 1
Range("A1", "N" & targetRow).AutoFilter
Range("A2").Select
ChDir ThisWorkbook.Path
ActiveWorkbook.SaveCopyAs FileName:= _
ThisWorkbook.Path & "\JIMS - Project Log - " & Year(Date) & "." & Format(Month(Date), "00") & "." & Format(Day(Date), "00") & ".xls"
Range("A1", "N" & targetRow).AutoFilter Field:=4, Criteria1:="<>toto", Operator:=xlAnd
Rows("2:" & targetRow).Delete shift:=xlUp
Range("A1", "N" & targetRow).AutoFilter Field:=4
Range("A2").Select
ChDir ThisWorkbook.Path
Application.DisplayAlerts = False
ThisWorkbook.Worksheets("Data").Delete
ThisWorkbook.Charts.Delete
Application.DisplayAlerts = True
ActiveWorkbook.SaveCopyAs FileName:= _
ThisWorkbook.Path & "\AMO Project Log - " & Year(Date) & "." & Format(Month(Date), "00") & "." & Format(Day(Date), "00") & ".xls"
MsgBox "Files : " & vbCr & _
" Project Log - " & Year(Date) & "." & Format(Month(Date), "00") & "." & Format(Day(Date), "00") & ".xls" & vbCr & _
" AMO Project Log - " & Year(Date) & "." & Format(Month(Date), "00") & "." & Format(Day(Date), "00") & ".xls" & vbCr & _
"have been created." & vbCr & vbCr & "In order to finish the archiving procedure, you must open these files and delete their macros (refer to the User Manual P700U).", _
vbInformation + vbOKOnly, "Archives created"
ThisWorkbook.Close False
End If
End If
End Sub
Mes connaissances en Vba sont très etriquées donc je vous serais reconnaissant si vous pouviez m'aider
Configuration: Windows 2000
Internet Explorer 6.0