当我使用 VBA 预先创建工作表时，为什么没有填充我的数据？

Question

以前，当我在 excel 中创建工作表索引 1,2,3 时，

它可以分别在索引 1 2 和 3 中这样排序

但是现在，如果我停止在 excel 中创建工作表而是通过 VBA，则无法填充数据，并且索引 1,2 和 3 为空。

这是我用于填充数据的代码，但添加了 add.sheets。 这里的 add.sheets 用于创建 index1,2,3 工作表，但它们不会触发程序继续填充数据，即使我在 VBA 中对它们进行编程时这些工作表存在。

 Sub UpdateVal()
        Static count As Long
        Dim iRow As Long
        Dim aRow As Long
        Dim a As Long
        Dim b As Long
        Dim selectRange As Range
        Dim lastline As Integer
        Dim sheetname As String
        Dim indexrowcount As Integer
        Dim wb As Workbook
        Dim ws As Worksheet
        Set wb = ActiveWorkbook
        Set ws = wb.Worksheets("Result")
        Set site_ai = Sheets.Add(after:=Sheets(Worksheets.count)) 
        site_ai.Name = "Index1"
        Set site_bi = Sheets.Add(after:=Sheets(Worksheets.count))
        site_bi.Name = "Index2"
        Set site_ci = Sheets.Add(after:=Sheets(Worksheets.count))
        site_ci.Name = "Index3"**


       '^additional codes sheets.Add added here for creating worksheets namely index1,2,3



        j = 2
        iRow = 1
        lastline = ws.UsedRange.Rows.count
        While iRow < lastline + 1
            a = iRow + 1
            b = iRow + 17 ' Max Group Size with Same name in F to H column
            count = 1
            If ws.Cells(iRow, "F").Value = "Martin1" Then
                sheetname = "Index1"
            ElseIf ws.Cells(iRow, "F").Value = "John1" Then
                sheetname = "Index2"
            Else
                sheetname = "Index3"
            End If
            For aRow = a To b
                If ws.Cells(iRow, "F") = ws.Cells(aRow, "F") And ws.Cells(iRow, "G") = ws.Cells(aRow, "G") And ws.Cells(iRow, "H") = ws.Cells(aRow, "H") Then
                    count = count + 1
                Else
                    Set selectRange = Range("A" & iRow & ":J" & aRow - 1)
                    selectRange.Copy
                    indexrowcount = Sheets(sheetname).UsedRange.Rows.count
                    Sheets(sheetname).Range("A" & indexrowcount).PasteSpecial xlPasteAll
                    iRow = iRow + count
                    Exit For
               End If
            Next aRow
        Wend
    End Sub

我在这里错过了什么，我应该如何解决？

Answer 1

你的代码太混乱了。 如果您的示例数据准确，我不明白您为什么需要检查所有三列。 您只需使用column F即可完成您想要做的事情。 如果您的数据已按所示排序，那么我将循环测试column F是否有重复项，直到不匹配为止。 然后我会添加一个工作表并使用起始单元格的值命名它。 然后将起始单元格中的行复制到当前rwNbr - 1并粘贴到新工作表。 重置下一组的起始单元格并循环。

Sub SaveRangewithConsecutiveDuplicateValuestoNewSheet()
'Define all variables
Dim wb As Workbook, ws As Worksheet, sCel As Range, rwNbr As Long

Set wb = ThisWorkbook 'Set workbook variable
Set ws = wb.Worksheets("Sheet1") 'set worksheet variable using workbook variable

Set sCel = ws.Cells(1, 6) 'Set the first start cell variable to test for duplicate values

    Application.DisplayAlerts = False
        For rwNbr = 2 To ws.Cells(ws.Rows.count, 6).End(xlUp).Offset(1).Row Step 1 'Loop

            If ws.Cells(rwNbr, 6).Value <> sCel.Value Then 'loop until the value changes
                wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.count)).Name = sCel.Value 'Add sheet and name based on the first cell of group

                ws.Range(sCel, ws.Cells(rwNbr - 1, 6)).EntireRow.Copy Destination:=ActiveSheet.Range("A1") 'select group of consecutive duplicates

                Set sCel = ws.Cells(rwNbr, 6) 'reset start cell to test for the next group of consecutive duplicates
            End If

        Next rwNbr
    Application.DisplayAlerts = True
End Sub