XL 2019 VBA For To avec Range

Hx2000

XLDnaute Nouveau
Bonjour à tous,

Je suis en galère avec un "For... To... Next" pour une partie de ma macro.

Le but de la macro est de remettre en horizontal des informations que j'ai à la verticale.

Tout va bien, ma macro fonctionne sauf que... j'ai environ 500 colonnes à construire. J'aimerais donc ne pas faire trop de lignes de code pour éviter de surcharger mes modules.

J'aimerais donc que vous m'aidiez à retravailler cette partie de mon code :

VB:
Sheets("PR_Chg").Cells(i, x) = WorksheetFunction.SumIfs(Worksheets("SAP").Range("I:I"), Worksheets("SAP").Range("E:E") _
, Worksheets("PR_Chg").Cells(i, 5), Worksheets("SAP").Range("G:G"), "marque", Worksheets("SAP").Range("A:A") _
, Cells(i, 1), Worksheets("SAP").Range("C:C"), Cells(i, 3), Worksheets("SAP").Range("F:F"), Worksheets("PR_Chg").Cells(i, 6))

J'aimerais qu'à chaque nouvelle colonne "X", le fichier aille rechercher la donnée de la colonne I, puis pour la colonne X+1 aller rechercher la donnée dans la colonne J, puis X+2 aller chercher dans la colonne K etc... Sans faire une ligne de code par colonne.

Merci beaucoup pour votre aide!

Hx.
 

Pièces jointes

  • Test chg_px.xlsm
    209.9 KB · Affichages: 24

Rouge

XLDnaute Impliqué
Bonjour,

Essayez ceci
VB:
Sub FR_PRChg()
    Dim i As Long, x As Long, DerLig_f1 As Long, DerLig_f2 As Long
    Dim f1 As Worksheet, f2 As Worksheet
    Application.ScreenUpdating = False
    Set f1 = Sheets("SAP")
    Set f2 = Sheets("PR_Chg")
    DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row
    DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row
    
    For i = 3 To DerLig_f2
        For x = 8 To 19
            If f2.Cells(i, 1) <> "" Then
                f2.Cells(i, 7) = WorksheetFunction.SumIfs(f1.Range("H2:H" & DerLig_f1), _
                f1.Range("E2:E" & DerLig_f1), f2.Cells(i, 5), _
                f1.Range("G2:G" & DerLig_f1), "P.V.", _
                f1.Range("A2:A" & DerLig_f1), Cells(i, 1), _
                f1.Range("C2:C" & DerLig_f1), Cells(i, 3), _
                f1.Range("F2:F" & DerLig_f1), f2.Cells(i, 6))
                
                'Range("I:I") à automatiser
                f2.Cells(i, x) = WorksheetFunction.SumIfs(f1.Range("I2:I" & DerLig_f1), _
                f1.Range("E2:E" & DerLig_f1), f2.Cells(i, 5), _
                f1.Range("G2:G" & DerLig_f1), "marque", _
                f1.Range("A2:A" & DerLig_f1), Cells(i, 1), _
                f1.Range("C2:C" & DerLig_f1), Cells(i, 3), _
                f1.Range("F2:F" & DerLig_f1), f2.Cells(i, 6))
                f2.Cells(i, 20) = WorksheetFunction.Sum(f2.Range(f2.Cells(i, 8), f2.Cells(i, 19)))
            End If
        Next x
    Next i
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

Cdlt
 

Discussions similaires

Réponses
5
Affichages
345
Réponses
17
Affichages
760
Réponses
7
Affichages
404

Membres actuellement en ligne

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 847
dernier inscrit
Djigbenou