Procedure trop large - Besoin de simplification

Le 01/12/2020 à 20:49

Bonjour. J'ai un module qui est trop gros. J'aurais besoin d'un coup de pouce pour le simplifier.
En gros j'ai un code qui va extraire de la données sur +- 150 fiches (donc une boucle dans un classeur), définie par la variable i

Dans chacune de ces fiches ll y a 3 sections ou je dois extraire de la données

  1. MAJ_strate arborescente ( x=85 à 96)
  2. MAJ régénération ( x = 104 à 117)
  3. MAJ herbacées ( x= 120 à 139)

Dans chacune des sections les lignes du début doivent se répéter (donc les lignes avant l'apparition de la variable x) qui me permettent ensuite de trier les données par station et strate.

Sub MAJ_for()

Dim WS_Count  As Integer
Dim I As Integer
WS_Count = ActiveWorkbook.Worksheets.Count
'**********************

'Début de la loop
'*******************************
For I = 1 To WS_Count
'*********************************
' MAj champs identification de la station & MAJ strate arborescente
'**********************************

Dim x As String
x = 85
Worksheets("FOR").Activate
Cells(Rows.Count, 1).End(xlUp)(2).Select
ActiveCell.Value = Worksheets(I).Range("d3").Value 'A:station
ActiveCell.Offset(0, 1).Activate 'déplacement d'une colonne
ActiveCell.Value = Worksheets(I).Range("B83").Value 'B: type de strate
ActiveCell.Offset(0, 1).Activate 'déplacement d'une colonne
ActiveCell.Value = Worksheets(I).Range("b" & x).Value 'c:essence_1
ActiveCell.Offset(0, 1).Activate 'déplacement d'une colonne
ActiveCell.Value = Worksheets(I).Range("o" & x).Value 'd:essence_1latin_1
ActiveCell.Offset(0, 1).Activate 'déplacement d'une colonne
ActiveCell.Value = Worksheets(I).Range("aa" & x).Value 'e :absolu
ActiveCell.Offset(0, 1).Activate 'déplacement d'une colonne
ActiveCell.Value = Worksheets(I).Range("ae" & x).Value 'f :relatif
ActiveCell.Offset(0, 1).Activate 'déplacement d'une colonne
ActiveCell.Value = Worksheets(I).Range("ai" & x).Value 'G :dominante
Worksheets("FOR").Activate
Cells(Rows.Count, 1).End(xlUp)(2).Select 'Retour à la colonne A

Copier/paste de la formule en changeant la valeur de X

Le X continu jusqu'à 96

'************************************************************
'MAJ strate  Régénération
'****************************************

x = 104 

Worksheets("FOR").Activate
Cells(Rows.Count, 1).End(xlUp)(2).Select
ActiveCell.Value = Worksheets(I).Range("d3").Value 'A:station
ActiveCell.Offset(0, 1).Activate 'déplacement d'une colonne
ActiveCell.Value = Worksheets(I).Range("B103").Value 'B: type de strate
ActiveCell.Offset(0, 1).Activate 'déplacement d'une colonne
ActiveCell.Value = Worksheets(I).Range("b" & x).Value 'c:essence_1
ActiveCell.Offset(0, 1).Activate 'déplacement d'une colonne
ActiveCell.Value = Worksheets(I).Range("o" & x).Value 'd:essence_1latin_1
ActiveCell.Offset(0, 1).Activate 'déplacement d'une colonne
ActiveCell.Value = Worksheets(I).Range("aa" & x).Value 'e :absolu
ActiveCell.Offset(0, 1).Activate 'déplacement d'une colonne
ActiveCell.Value = Worksheets(I).Range("ae" & x).Value 'f :relatif
ActiveCell.Offset(0, 1).Activate 'déplacement d'une colonne
ActiveCell.Value = Worksheets(I).Range("ai" & x).Value 'G :dominante
Worksheets("FOR").Activate
Cells(Rows.Count, 1).End(xlUp)(2).Select 'Retour à la colonne A

Copier/paste de la formule en changeant la valeur de X
x = de 105 à 117

'************************************************
'Strate non-ligneuse
'***********************
x = 120 à 139, donc copie/ paste de la formule en changeant le X de valeur 

Worksheets("FOR").Activate
Cells(Rows.Count, 1).End(xlUp)(2).Select
ActiveCell.Value = Worksheets(I).Range("d3").Value 'A:station
ActiveCell.Offset(0, 1).Activate 'déplacement d'une colonne
ActiveCell.Value = Worksheets(I).Range("B119").Value 'B: type de strate
ActiveCell.Offset(0, 1).Activate 'déplacement d'une colonne
ActiveCell.Value = Worksheets(I).Range("b" & x).Value 'c:essence_1
ActiveCell.Offset(0, 1).Activate 'déplacement d'une colonne
ActiveCell.Value = Worksheets(I).Range("o" & x).Value 'd:essence_1latin_1
ActiveCell.Offset(0, 1).Activate 'déplacement d'une colonne
ActiveCell.Value = Worksheets(I).Range("aa" & x).Value 'e :absolu
ActiveCell.Offset(0, 1).Activate 'déplacement d'une colonne
ActiveCell.Value = Worksheets(I).Range("ae" & x).Value 'f :relatif
ActiveCell.Offset(0, 1).Activate 'déplacement d'une colonne
ActiveCell.Value = Worksheets(I).Range("ai" & x).Value 'G :dominante
Worksheets("FOR").Activate
Cells(Rows.Count, 1).End(xlUp)(2).Select 'Retour à la colonne A

x = 121

Worksheets("FOR").Activate
Cells(Rows.Count, 1).End(xlUp)(2).Select
ActiveCell.Value = Worksheets(I).Range("d3").Value 'A:station
ActiveCell.Offset(0, 1).Activate 'déplacement d'une colonne
ActiveCell.Value = Worksheets(I).Range("B119").Value 'B: type de strate
ActiveCell.Offset(0, 1).Activate 'déplacement d'une colonne
ActiveCell.Value = Worksheets(I).Range("b" & x).Value 'c:essence_1
ActiveCell.Offset(0, 1).Activate 'déplacement d'une colonne
ActiveCell.Value = Worksheets(I).Range("o" & x).Value 'd:essence_1latin_1
ActiveCell.Offset(0, 1).Activate 'déplacement d'une colonne
ActiveCell.Value = Worksheets(I).Range("aa" & x).Value 'e :absolu
ActiveCell.Offset(0, 1).Activate 'déplacement d'une colonne
ActiveCell.Value = Worksheets(I).Range("ae" & x).Value 'f :relatif
ActiveCell.Offset(0, 1).Activate 'déplacement d'une colonne
ActiveCell.Value = Worksheets(I).Range("ai" & x).Value 'G :dominante
Worksheets("FOR").Activate
Cells(Rows.Count, 1).End(xlUp)(2).Select 'Retour à la colonne A

Next I

End Sub

Merci de votre support.

Le 02/12/2020 à 09:22

bonjour,

ça devrait donner qu.qu. chose comme ça :

Sub MAJ_for()
Dim i%, x%, iR&, WsF As Worksheet
Set WsF = Worksheets("FOR")
iR = WsF.Cells(WsF.Rows.Count, 1).End(xlUp)(2).Row
'*******************************
For i = 1 To Worksheets.Count
With Worksheets(i)
'*********************************
' MAj champs identification de la station & MAJ strate arborescente
'**********************************

For x = 85 To 96
   WsF.Cells(iR, 1) = .Range("D3")     'A:station
   WsF.Cells(iR, 2) = .Range("B83")    'B: type de strate
   WsF.Cells(iR, 3) = .Range("B" & x)  'c:essence_1
   WsF.Cells(iR, 4) = .Range("O" & x)  'd:essence_1latin_1
   WsF.Cells(iR, 5) = .Range("AA" & x) 'e :absolu
   WsF.Cells(iR, 6) = .Range("AE" & x) 'f :relatif
   WsF.Cells(iR, 7) = .Range("AI" & x) 'G :dominante
      iR = iR + 1
Next

'************************************************************
'MAJ strate  Régénération
'****************************************

For x = 105 To 117
   WsF.Cells(iR, 1) = .Range("D3")     'A:station
   WsF.Cells(iR, 2) = .Range("B103")   'B: type de strate
   WsF.Cells(iR, 3) = .Range("B" & x)  'c:essence_1
   WsF.Cells(iR, 4) = .Range("O" & x)  'd:essence_1latin_1
   WsF.Cells(iR, 5) = .Range("AA" & x) 'e :absolu
   WsF.Cells(iR, 6) = .Range("AE" & x) 'f :relatif
   WsF.Cells(iR, 7) = .Range("AI" & x) 'G :dominante
      iR = iR + 1
Next

'************************************************
'Strate non-ligneuse
'***********************

For x = 120 To 139
   WsF.Cells(iR, 1) = .Range("D3")     'A:station
   WsF.Cells(iR, 2) = .Range("B119")   'B: type de strate
   WsF.Cells(iR, 3) = .Range("B" & x)  'c:essence_1
   WsF.Cells(iR, 4) = .Range("O" & x)  'd:essence_1latin_1
   WsF.Cells(iR, 5) = .Range("AA" & x) 'e :absolu
   WsF.Cells(iR, 6) = .Range("AE" & x) 'f :relatif
   WsF.Cells(iR, 7) = .Range("AI" & x) 'G :dominante
      iR = iR + 1
Next

x = 121
   WsF.Cells(iR, 1) = .Range("D3")     'A:station
   WsF.Cells(iR, 2) = .Range("B119")   'B: type de strate
   WsF.Cells(iR, 3) = .Range("B" & x)  'c:essence_1
   WsF.Cells(iR, 4) = .Range("O" & x)  'd:essence_1latin_1
   WsF.Cells(iR, 5) = .Range("AA" & x) 'e :absolu
   WsF.Cells(iR, 6) = .Range("AE" & x) 'f :relatif
   WsF.Cells(iR, 7) = .Range("AI" & x) 'G :dominante
      iR = iR + 1

End With
Next i
End Sub

A+

Le 02/12/2020 à 19:49

Merci Galopin

Ca fonctionne bien.

Rechercher des sujets similaires à "procedure trop large besoin simplification"