Problème d'execution de macro dans plusieurs classeurs

Sub Macro12()
  Dim wb As Workbook, I As Long, J As Long, K As Long
  Dim DerniereLigne As Long, MaValeur
  Dim MonID As Long
  '
  ' Touche de raccourci du clavier: Ctrl+n
  ' Initialisation des variables ICI pour éviter la remise à ZERO
  MonID = 0: J = 1: K = 1
  ' Pour chaque classeur
  For Each wb In Application.Workbooks
    ' Initialisation des variables ICI pour remise à ZERO
    ' MonID = 0: J = 1: K = 1
    If wb.Name Like "Analyse*" Then
      wb.Activate
      wb.Sheets("Feuil1").Move Before:=Sheets(1)
      wb.Sheets("Concaténation").Columns("A:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
      wb.Sheets("Feuil1").Move Before:=Sheets(1)
      DerniereLigne = wb.Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
      For I = 1 To DerniereLigne
        If wb.Sheets(1).Cells(I, 1).Value <> "" Then
          MonID = MonID + 1
          MaValeur = Sheets(1).Cells(I, 1).Value
          wb.Sheets(2).Cells(J, 1).Value = MonID
          wb.Sheets(2).Cells(J, 2).Value = Sheets(1).Cells(I, 1).Value
          J = J + 1
        End If
        wb.Sheets(3).Cells(K, 1).Value = MonID
        wb.Sheets(3).Cells(K, 2).Value = Sheets(1).Cells(I, 2).Value
        K = K + 1
      Next
      wb.Sheets(2).Name = "Danger"
      wb.Sheets(3).Name = "Mesure"
    End If
  Next wb
End Sub