将数据复制到不同的命名多个工作表中
将数据复制到不同的命名多个工作表中
提问于 2018-11-25 13:30:58
亲爱的，
我是一个初学者，并尝试准备宏，它允许首先根据条件删除行，而不是根据第一个主表的标准创建新的工作表，并将第一个主表的数据添加到多个指定的工作表中。
- 根据条件删除行(运行确定)
- 根据第一个主表的条件创建新的工作表(运行确定)
- 将第一个主表(常量范围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 SubStack Overflow用户
回答已采纳
发布于 2018-11-25 14:06:16
不太确定您的描述，但您可以尝试如下：
编辑了以添加工作表变量并防止任何(可能吗？)在添加和写入新工作表之间的时间间隔错误行为(通过隐式地假设它为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页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/53467982
复制相关文章
相似问题
腾讯云开发者
