不正确的复制列

我正在尝试为excel创build一些VBA代码，这将允许我将许多产品的数据复制到与产品同名的新工作表中。 每个产品的不同数据由一列未被复制到新工作表的date分隔。 我创build了下面的代码，它适用于一个产品，但是当我添加第二个产品的代码出错了。 不是复制第二个产品的第一列，而是复制第三个产品，然后直接跳到第二个产品的第二个列。 所以代码留下了第二个产品的全部第一列。

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

想出了这个问题。 第二个产品的第一个循环没有返回到input表。 这是固定的代码。

 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