Неправильное копирование столбцов

Question

Я пытаюсь создать код VBA для excel, который позволит мне скопировать данные из ряда продуктов в новый лист с тем же именем, что и продукт. Различные данные для каждого продукта разделяются одним столбцом дат, которые не копируются в новый лист. Я создал следующий код, и он работает для одного продукта, однако, когда я добавляю второй продукт, код идет не так. Вместо копирования первого столбца из второго продукта он копирует третий столбец из предыдущего продукта, а затем перескакивает прямо во второй столбец второго продукта. Таким образом, код не содержит полный первый столбец второго продукта.

Sub Forecast_Products() 
Dim iterations As Integer 
iterations = Cells(68, 1).Value 
Dim i As Integer, j As Integer 
For i = 1 To iterations 
    Cells(69, i).Value = 0 
    For j = 2 To 6 Step 2 
     Dim startCell As String, endCell As String 
     startCell = Col_Letter(j + 7 * (i - 1)) & "9" 
     endCell = Col_Letter(j + 7 * (i - 1)) & "60" 
     Range(startCell, endCell).Select 
     Dim salesCount As Integer 
     salesCount = Cells(69).Value 
     Cells(69).Value = salesCount + Application.WorksheetFunction.CountIf(Range(startCell, endCell), ">=0") 
     Selection.Copy 
     Dim productName As String 
     Sheets("Input").Activate 
     productName = Cells(70, i).Value 
     MsgBox (productName & " 70, " & CStr(i)) 
     Sheets(productName).Activate 
     Dim rowStart As Variant 
     rowStart = CStr(11 + (52 * (j/2 - 1))) 
     Range("B" & rowStart).Select 
     Selection.PasteSpecial xlValue 
     Range("M" & rowStart).Select 
     Selection.PasteSpecial xlValue 
     Sheets("Input").Activate 
    Next 
    Dim rowCount As Integer 
    rowCount = Cells(69, i).Value + 10 
    Sheets(Cells(70, i).Value).Activate 
    For j = 4 To 8 
     Dim formula As Variant 
     formula = Cells(17, j).Copy 
     startCell = Col_Letter(j) & "18" 
     endCell = Col_Letter(j) & CStr(rowCount) 
     Range(startCell, endCell).Select 
     Selection.PasteSpecial xlAll 
    Next 
Next 

End Sub 

Function Col_Letter(lngCol As Integer) As String 
Dim vArr 
vArr = Split(Cells(1, lngCol).Address(True, False), "$") 
Col_Letter = vArr(0) 
End Function 

Answer 1

Понял проблему. Первый цикл для второго продукта не вернулся к входному листу. Это фиксированный код.

Sub Forecast_Products() 
Dim iterations As Integer 
iterations = Cells(68, 1).Value 
Dim i As Integer, j As Integer 
For i = 1 To iterations 
    Cells(69, i).Value = 0 
    For j = 2 To 6 Step 2 
     Dim startCell As String, endCell As String 
     startCell = Col_Letter(j + 6 * (i - 1)) & "9" 
     endCell = Col_Letter(j + 6 * (i - 1)) & "60" 
     Sheets("Input").Activate 
     Range(startCell, endCell).Select 
     Dim salesCount As Integer 
     salesCount = Cells(69).Value 
     Cells(69).Value = salesCount + Application.WorksheetFunction.CountIf(Range(startCell, endCell), ">=0") 
     Selection.Copy 
     Dim productName As String 
     Sheets("Input").Activate 
     productName = Cells(70, i).Value 
     'MsgBox (productName & " 70, " & CStr(i)) 
     Sheets(productName).Activate 
     Dim rowStart As Variant 
     rowStart = CStr(11 + (52 * (j/2 - 1))) 
     Range("B" & rowStart).Select 
     Selection.PasteSpecial xlValue 
     Range("M" & rowStart).Select 
     Selection.PasteSpecial xlValue 
     Sheets("Input").Activate 
    Next 
    Dim rowCount As Integer 
    rowCount = Cells(69, i).Value + 10 
    Sheets(Cells(70, i).Value).Activate 
    For j = 4 To 8 
     Dim formula As Variant 
     formula = Cells(17, j).Copy 
     startCell = Col_Letter(j) & "18" 
     endCell = Col_Letter(j) & CStr(rowCount) 
     Range(startCell, endCell).Select 
     Selection.PasteSpecial xlAll 
    Next 
Next 

End Sub 

Function Col_Letter(lngCol As Integer) As String 
Dim vArr 
vArr = Split(Cells(1, lngCol).Address(True, False), "$") 
Col_Letter = vArr(0) 
End Function