Création d'une boucle pour une plage de lignes pour un code qui s'exécute sur une seule ligne

Question

Je crée une macro qui créera un rapport automatique (le nom de la feuille de rapport est "RCCP INPUT"), en extrayant des données d'une autre feuille de calcul (source nommée "CW33 17"). J'ai construit le code qui s'exécute pour une seule ligne de la feuille source, de sorte qu'il crée le rapport pour une seule ligne (chaque ligne représente un ordre). Je veux avoir un rapport pour une série de lignes, donc j'ai besoin d'étendre mon code pour appliquer une série de lignes. Donc, disons que cette plage s'appelle myRange et qu'elle inclut les lignes 2 à 70. Donc, mon rapport doit avoir toutes ces lignes. Mon code est fourni ci-dessous. J'ai également inclus les en-têtes, donc le rapport commence à partir de la ligne 2. La ligne pour laquelle la macro s'exécute, pour l'instant est la ligne 2. Juste pour clarifier davantage, le rapport doit avoir chaque ligne sélectionnée à partir de la source multipliée par 6 (6 copies, l'une en dessous de l'autre) comme on peut le voir dans la macro ci-dessous, car dans la colonne Prévision et Quantité de prévision, chaque commande (ligne) doit avoir des valeurs pour 6 semaines. J'espère que je l'ai bien clarifié! Des idées comment le faire fonctionner? .. J'ai échoué lamentablement jusqu'à présent .. Très apprécié! Le rapport ressemble à ceci (pour une ligne - multipliée par 6) et les autres rangées doivent être placées de la même manière en dessous.

Sub RCCP_INPUT() 

Sheets("RCCP INPUT").Select 

    range("C1").Value = "T-Lane ID"     'Column C 
    range("D1").Value = "Week of RCCP"     'Column D 
    range("E1").Value = "Forecast"      'Column E 
    range("F1").Value = "Forecast Quantity"   'Column F 

    Sheets("CW33 17").Select 
    range("D2:E2").Copy 
    Sheets("RCCP INPUT").Select 
    range("A2").Select 
    ActiveSheet.Paste 
    Dim rws As Long 
    With range("A2:B2") 
    rws = .Rows.Count 
    .Resize(rws).Copy Destination:=.Offset(rws).Resize(rws * 5) 
    End With 
    range("C2").Select 
    ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],RC[-1])" 
    ActiveCell.Value = ActiveCell.Value 
    With range("C2") 
    rws = .Rows.Count 
    .Resize(rws).Copy Destination:=.Offset(rws).Resize(rws * 5) 
    End With 
    Sheets("CW33 17").Select 
    range("G2:L2").Select 
    Selection.Copy 
    Sheets("RCCP INPUT").Select 
    range("F2:F7").Select 
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True 
    Sheets("RCCP INPUT").Select 
    i = 1 
    For Each cell In range("E2:E7") 
     cell.Value = "Week +" & i 
     i = i + 1 
    Next cell 
    Sheets("RCCP INPUT").Select 
    range("E2").Value = Sheets("CW33 17").range("G2").Value - 1 
    With range("E2") 
    rws = .Rows.Count 
    .Resize(rws).Copy Destination:=.Offset(rws).Resize(rws * 5) 
    End With 

End Sub 

Answer 1

Afin de généraliser votre code, vous devez éloigner des adresses absolues en quelque sorte. L'one-way est d'assigner des ranges et puis les compensent comme nécessaire pour arriver aux positions dont vous avez besoin. Le code ci-dessous passe par numNeeded nombre de fois et continue à ajouter directement ci-dessous que vous mentionnez. Je ne sais rien sur les données source après la première fois, donc il ne fait que répéter le premier ensemble de données en ce moment. Mais vous pouvez dessiner de nouvelles données à partir de différentes feuilles ou utiliser des décalages sur la feuille source pour saisir de nouvelles données à chaque fois. J'ai mis beaucoup d'instructions r.select dans le code afin que vous puissiez passer à travers et facilement voir ce que le code fait, mais ceux-ci devraient être supprimés une fois que vous comprenez.

Sub reportGen() 
    Dim destSh As Worksheet, sourceSh As Worksheet 
    Dim sourceR1 As Range, sourceR2 As Range 
    Dim r As Range, pasteR As Range 
    Const numNeeded = 10 
    Set sourceSh = Worksheets("CW33 17") 
    Set sourceR1 = sourceSh.Range("D2:E2") 
    Set sourceR2 = sourceSh.Range("G2:L2") 
    Set destSh = Worksheets("RCCP INPUT") 
    Set r = destSh.Range("A1").Offset(7 * j, 0) 
    r.Select 
    r.Offset(0, 2) = "T-Lane ID" 
    r.Offset(0, 3) = "Week of RCCP" 
    r.Offset(0, 4) = "Forecast" 
    r.Offset(0, 5) = "Forecast Quantity" 
    For j = 0 To numNeeded 
    Set r = destSh.Range("A2").Offset(j * 6, 0) 
    r.Select 
    sourceR1.Copy 
    destSh.Paste 
    Set pasteR = Selection 
    pasteR.AutoFill destSh.Range(pasteR, pasteR.Offset(5, 0)) 
    Set r = r.Offset(0, 2) 
    r.Select 
    r.FormulaR1C1 = "=CONCATENATE(RC[-2],RC[-1])" 
    r = r.Value 
    r.AutoFill destSh.Range(r, r.Offset(5, 0)) 
    Set r = r.Offset(0, 3) 
    r.Select 
    sourceR2.Copy 
    r.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True 
    Set r = r.Offset(0, -1) 
    r.Select 
    For i = 1 To 6 
     r.Offset(i - 1, 0) = "Week +" & i 
    Next i 
    r = sourceR2(1) - 1 
    r.AutoFill destSh.Range(r, r.Offset(5, 0)) 
    r.Select 
    Next j 
End Sub 

(Soit dit en passant, je pense qu'il pourrait y avoir un départ d'erreur après votre boucle For Each cell... car il écrit sur les données, mais je ne savais pas si juste gardé la façon dont vous l'avez)