Discussion :

[js777]

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 :


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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 : Rondes sharepoint test.xlsm

[Menhir]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range ("F2", Cells(Rows.Count, "F").End(xlUp))

[js777]

Bonjour Menhir,

Merci pour ta réponse,

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


J'ai sûrement du oublier quelque chose,

Le fichier test : forumexcel2.xlsm

[Menhir]

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.

[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 :



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 :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
dL = .Range("A1").CurrentRegion.Rows.Count
        .Range("F2:J" & dL).FormulaR1C1 = .Range("F2:J2").FormulaR1C1

[js777]

Menhir, c'est la même chose quand ("Feuil2") est active

[Patrice740]

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

[Patrice740]

RE,

Essaies :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Patrice740]

Corriges par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

EDIT : avec une procédure commune :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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