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

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

1 个答案: