excel - 将数据复制到不同的命名多个工作表中

Question

亲爱的，

我是一个初学者，并试图准备一个宏，该宏首先允许根据条件删除行，而不是根据第一个主工作表中的标准创建新工作表并将第一个主工作表中的数据添加到多个命名工作表中。

根据条件删除行(运行正常)

根据第一个主工作表的标准创建新工作表(运行正常)

从第一个主表添加数据(恒定范围 I4:I6)
到 A1:A3 的多个命名表中(由该宏创建)。不幸的是我不知道该怎么做:-(

你能帮我吗？

Private Sub CommandButton1_Click()

   Dim lastrow As Long, x As Long
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    For x = lastrow To 1 Step -1
        If UCase(Cells(x, 3).Value) = "0" And _
        UCase(Cells(x, 6).Value) = "0" Then
        Rows(x).Delete
        End If
    Next

    lastcell = ThisWorkbook.Worksheets("Obratova predvaha").Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To lastcell

    With ThisWorkbook

    newname = ThisWorkbook.Worksheets("Obratova predvaha").Cells(i, 1).Value

    .Sheets.Add after:=.Sheets(.Sheets.Count)

    ActiveSheet.Name = newname

    End With

    Next

    ThisWorkbook.Worksheets("Obratova predvaha").Activate
    ThisWorkbook.Worksheets("Obratova predvaha").Cells(1, 1).Select

End Sub

Answer 1

不太确定你的描述，但你可以试试这个:

已编辑 添加一个工作表变量并通过隐式假设它为 ActiveSheet 来防止新工作表添加和写入之间的任何(可能的？)时间间隔错误行为:

Option Explicit

Private Sub CommandButton1_Click()
    Dim lastrow As Long, i As Long
    Dim newSheet As Worksheet

    With Worksheets("Obratova predvaha")
        lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = lastrow To 1 Step -1
            If UCase(.Cells(i, 3).Value) = "0" And UCase(.Cells(i, 6).Value) = "0" Then .Rows(i).Delete
        Next

        lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To lastrow
            Set newSheet = Sheets.Add(after:=Sheets(Sheets.Count)) ' add a new sheet and hold its reference in newSheet  variable
            newSheet.Range("A1:A3").Value = .Range("I4:I6").Value ' copy referenced sheet I4:I6 values into newly added sheet cells A1:A3
            newSheet.Name = .Cells(i, 1).Value ' change the name of newly added sheet
        Next
    End With
End Sub