XL 2010 Correction et optimisation de code

[fb62840]

Bonjour,

J'utilise le code ci-dessous pour obtenir le report de données d'un fichier à l'autre.

J'ai 2 soucis :
Les reports ne semble pas se faire correctement (j'ai bien des données reportées mais ce ne sont pas les bonnes, peut être y-a-t-il un problème de ligne)
L'exécution est extrêmement lente (pourriez-vous m'aider à accélérer l'exécution ?)

2 fichiers en pièce-jointe avec explications sur feuille explications

Merci beaucoup pour votre aide.

Sub ACTU()
  Dim NumSem, NOM, CAUSE, Mois, AdresseNom As String
  Dim REM As Boolean
  Dim PlanCong, Plan As Workbook
  Dim result As Range
  Dim Jour As Byte
  NumSem = UCase(Range("B1").Value)
  Mois = Range("A1").Value & " " & Range("A2").Value
  Application.ScreenUpdating = False  
  Set PlanCong = Workbooks.Add("C:\ACT2017\DEVO\Plan_Orga_2017.xlsx")
  Set Plan = Workbooks("PLANNIF 2017")
  Workbooks("PLANNIF 2017").Activate
  Range("A23", "A146").Select 'C'est là que se trouvent les noms
  For Each Cell In Selection
  NOM = Cell.Value 
  If NOM<> "" Then 
  For i = 2 To 10 Step 2
  PlanCong.Worksheets(Mois).Activate 'on active la feuille 

  If NumMois(Month(Plan.Sheets(NumSem).Cells(2, i).Value)) & " 2017" <> Mois Then
  PlanCong.Worksheets(NumMois(Month(Plan.Sheets(NumSem).Cells(2, i).Value)) & " 2017").Activate
  Mois = ActiveSheet.Name
  End If

  Set result = PlanCong.Worksheets(Mois).Range("A1:A92").Find(What:=NOM, LookIn:=xlValues)

  If result Is Nothing Then GoTo fin
   AdresseNom = result.Address
  Jour = Day(Plan.Worksheets(NumSem).Cells(2, i).Value

  Select Case Range(AdresseNom).Offset(0, Jour).Value
  Case Is = "M"
  Cell.Offset(0, i).Value = "M"
   Case Is = "R"
  Cell.Offset(0, i).Value = "R"
  Case Is = "T"
  Cell.Offset(0, i).Value = "T"
  Case Else
  If Range(AdresseNom).Offset(0, Jour).Value <> "" Then
  Cell.Offset(0, i).Value = Range(AdresseNom).Offset(0, Jour).Value  '"ABS"
  Else
  Cell.Offset(0, i).Value = ""
  End If
  End Select

  Select Case Range(AdresseNom).Offset(-1, Jour).Value
  Case Is = "M"
  Cell.Offset(0, i - 1).Value = "M"
  Case Is = "R"
  Cell.Offset(0, i - 1).Value = "R"
  Case Is = "T"
  Cell.Offset(0, i - 1).Value = "T"
   Case Else
   If Range(AdresseNom).Offset(-1, Jour).Value <> "" Then
  Cell.Offset(0, i - 1).Value = Range(AdresseNom).Offset(-1, Jour).Value '"ABS"

  Else
  Cell.Offset(0, i - 1).Value = ""
  End If
  End Select

  Next i
  End If
  Next

  PlanCong.Close SaveChanges:=False

  Application.ScreenUpdating = True
  Set PlanCong = Nothing
End Sub

 

[Robert]

Bonjour Fb, bonjour le forum,

D'abord les erreurs...

Au niveau des déclarations des variables. Tu peux déclarer plusieurs variables dans la même ligne mais il te faut en spécifier le type de chacune d'entre elles. Sinon elle prendra le type Variant par défaut, gourmand en mémoire. La ligne :
Dim NumSem, NOM, CAUSE, Mois, AdresseNom As String
doit être :
Dim NumSem As Byte (?) , NOM As String, CAUSE As String, Mois As String, AdresseNom As String

REM est un mot clé Visual Basic (regarde l'aide VBA). Tu ne peux pas utiliser une variable avec ce mot.

NumSem = UCase(Range("B1").Value)
Quel classeur ? Quel onglet ? Si je lance ta macro telle quelle j'obtiens NumSem = ""
Idem avec la variable Mois, j'obtiens Mois = "Bonjour".

Quand tu utilise une étiquette GOTO il te faut la définir à l'endroit où tu désires renvoyer le code.
If result Is Nothing Then GoTo fin
il te faut, quelque part dans le code, une ligne au-dessus l'endroit ou tu veux renvoyer le code, un :
fin:
Si tu désires, non pas, aller à une étiquette mais sortir de la procédure, utilise plutôt :
If result Is Nothing Then Exit Sub

Il te manque une parenthèse à la fin de la ligne :
Jour = Day(Plan.Worksheets(NumSem).Cells(2, i).Value)

Pour vérifier un code il faut placer le curseur dedans et le faire tourner pas à pas avec la touche [F7]. Je ne comprends pas que tu n'arrive(s) pas à isoler les erreurs pour comprendre ce qui se passe... Puisque dès qu'il y a erreur le code s'arrête et la ligne qui pose problème est surlignée de jaune.

Pour finir, le nom du second fichier ne correspond pas dans le code au nom du fichier exemple fourni !... Et en plus il y a un mot de passe ! Pas mal...

 

[fb62840]

Bonjour,

merci pour les explications, je vais essayer de partir de là.