Selection rang dynamique

Version imprimable

2 pièce(s) jointe(s)

Bonjour tout le monde,

J'ai un classeur avec une requête vers une liste SharePoint intégrant régulièrement de nouvelles données dans un tableau :
Pièce jointe 543582

Des macros viennent copier chacune des colonnes de données dans des feuilles respectives et réaliser des traitement dessus :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub SSA3()
'
' SSA3 Macro
'
 
'
With Sheets("SSA3").Activate
 
    Worksheets("Données Brutes").Range("A:B").Copy Worksheets("SSA3").Range("A1")
    Worksheets("SSA3").Range("A:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 
    Worksheets("SSA3").Range("E2") = Worksheets("Données Brutes").Range("M13").Formula
    Worksheets("SSA3").Range("F2") = Worksheets("Données Brutes").Range("M14").Formula
    Worksheets("SSA3").Range("G2") = Worksheets("Données Brutes").Range("M15").Formula
    Worksheets("SSA3").Range("H2") = Worksheets("Données Brutes").Range("M16").Formula
    Worksheets("SSA3").Range("I2") = Worksheets("Données Brutes").Range("M17").Formula
    Worksheets("SSA3").Range("J2") = Worksheets("Données Brutes").Range("M18").Formula
 
    Worksheets("SSA3").Range("F2").Select
    Selection.AutoFill Destination:=Range("F2:F150"), Type:=xlFillDefault
    Worksheets("SSA3").Range("G2").Select
    Selection.AutoFill Destination:=Range("G2:G150"), Type:=xlFillDefault
    Worksheets("SSA3").Range("H2").Select
    Selection.AutoFill Destination:=Range("H2:H150"), Type:=xlFillDefault
    Worksheets("SSA3").Range("I2").Select
    Selection.AutoFill Destination:=Range("I2:I150"), Type:=xlFillDefault
    Worksheets("SSA3").Range("J2").Select
    Selection.AutoFill Destination:=Range("J2:J150"), Type:=xlFillDefault
 
    Worksheets("SSA3").Range("A:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 
End With
 
End Sub

Comment pourrais-je remplacer

Code:

Range ("F2:F150")

pour que le rang de la colonne F sélectionné soit égal à la taille de la colonne "A" remplie ?

Voici mon fichier : Pièce jointe 543585

06/03/2020, 11h05
Menhir

Code:

Range ("F2", Cells(Rows.Count, "F").End(xlUp))
06/03/2020, 11h42
js777

2 pièce(s) jointe(s)

Bonjour Menhir,

Merci pour ta réponse,

J'ai essayé sur un fichier test ça m'a renvoyé cette erreur :
Pièce jointe 543611

J'ai sûrement du oublier quelque chose,

Le fichier test : Pièce jointe 543613

RE,

Essaies :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub SSA3()
'
' SSA3 Macro
'
Dim fD As Worksheet
Dim f3 As Worksheet
Dim dL As Long
  Set fD = Worksheets("Données Brutes")
  Set f3 = Worksheets("SSA3")
  With f3
    fD.Range("A:B").Copy .Range("A1")
    .Range("A:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    .Range("E2").Value = fD.Range("M13").Formula  'ou  .Range("E2").Formula = fD.Range("M13").Formula ????
    .Range("F2").Value = fD.Range("M14").Formula
    .Range("G2").Value = fD.Range("M15").Formula
    .Range("H2").Value = fD.Range("M16").Formula
    .Range("I2").Value = fD.Range("M17").Formula
    .Range("J2").Value = fD.Range("M18").Formula
    dL = .Range("A1").CurrentRegion.Rows.Count
    .Range("F2:J" & dL).FormulaR1C1 = .Range("F2:J2").FormulaR1C1
  End With
End Sub

06/03/2020, 12h20
Menhir

Citation:

Envoyé par js777

J'ai essayé sur un fichier test ça m'a renvoyé cette erreur :

C'est vraisemblablement parce que Feuil2 n'est pas la feuille active.
Donc tu demandes d'étendre une cellule de Feuil2 jusqu'à une cellule se trouvant dans une autre feuille. Normal que VBA ne comprenne pas.
09/03/2020, 10h57
js777

1 pièce(s) jointe(s)
Patrice, merci pour ta réponse, j'ai testé ton code, au moment de l'auto-remplissage des colonnes avec les formules, les cellules sélectionnées par les formules ne correspondent pas aux bonnes lignes :

Pièce jointe 544258

Ici, la cellule G3 contient la formule B4-F4 alors qu'elle devrait contenir B3-F3, et il en va de même pour les cellules suivantes de la colonnes G, certaines lignes semblent sautées, ce qui nous donne B172-F172 pour la cellule G87 alors qu'elle devrait contenir la formule B172-F172.

Cela a également un effet sur les colonnes suivantes (H, I et K) en décalant encore plus les formules,

J'ai également du mal à comprendre cette partie du code :
Code:

1 2 dL = .Range("A1").CurrentRegion.Rows.Count .Range("F2:J" & dL).FormulaR1C1 = .Range("F2:J2").FormulaR1C1
09/03/2020, 10h58
js777

Menhir, c'est la même chose quand ("Feuil2") est active
09/03/2020, 11h18
Patrice740

Citation:

Envoyé par js777

Patrice, merci pour ta réponse, j'ai testé ton code, au moment de l'auto-remplissage des colonnes avec les formules, les cellules sélectionnées par les formules ne correspondent pas aux bonnes lignes

Certainement à cause de la formule en F2 qui n'est pas bonne dès le départ. Vérifies les formules en F2:J2
09/03/2020, 11h42
js777

Citation:

Envoyé par Patrice740

Certainement à cause de la formule en F2 qui n'est pas bonne dès le départ. Vérifies les formules en F2:J2

Les formules sont bonnes, ce sont les cellules apparaissant dans les formules qui ne correspondent pas,

Avec l'ancienne macro il n'y a pas ce problème donc a priori les formules sont correctes

Corriges par :

Code:

.Range("F2:J" & dL).Formula = .Range("F2:J2").Formula

EDIT : avec une procédure commune :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Option Explicit
Sub SSA1()
  Call Transfert("SSA1")
End Sub
'...
Sub SSA3()
  Call Transfert("SSA3")
End Sub
 
Sub Transfert(nomFeuille As String)
Dim fD As Worksheet
Dim f3 As Worksheet
Dim cel As Range
Dim dL As Long
  Set fD = Worksheets("Données Brutes")
  Set f3 = Worksheets(nomFeuille)
  With f3
    .Cells.ClearContents
    Set cel = fD.Rows(1).Find("Index_" & nomFeuille, , xlValues, xlWhole)
    If Not cel Is Nothing Then
      Union(fD.Columns(1), cel.EntireColumn).Copy .Range("A1")
      .Range("A:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
      .Range("E2").Value = fD.Range("M13").Formula
      .Range("F2").Value = fD.Range("M14").Formula
      .Range("G2").Value = fD.Range("M15").Formula
      .Range("H2").Value = fD.Range("M16").Formula
      .Range("I2").Value = fD.Range("M17").Formula
      .Range("J2").Value = fD.Range("M18").Formula
      dL = .Range("A1").CurrentRegion.Rows.Count
      .Range("F2:J" & dL).Formula = .Range("F2:J2").Formula
    Else
      MsgBox "Colonne « Index_" & nomFeuille & " » non trouvée."
    End If
  End With
End Sub
 
Sub Tous()
  Call Transfert("SSA1")
  Call Transfert("SSA2")
  Call Transfert("SSA3")
  Call Transfert("SSA4")
  Call Transfert("PG1")
  Call Transfert("PG2")
  Call Transfert("PR")
  Call Transfert("PS")
End Sub