level 5
level 5
![[黑线]](/static/emoticons/u9ed1u7ebf.png)
level 11
Option Explicit
Sub test()
Dim rng
Sheets("sheet2").Cells.ClearContents
For Each rng In Sheets("sheet1").UsedRange
If rng.Value = "优秀" Then Sheets("sheet2").Cells(rng.Row, rng.Column) = "优秀"
Next
End Sub
2017年08月19日 04点08分
3
Sub test()
Dim rng
Sheets("sheet2").Cells.ClearContents
For Each rng In Sheets("sheet1").UsedRange
If rng.Value = "优秀" Then Sheets("sheet2").Cells(rng.Row, rng.Column) = "优秀"
Next
End Sub
兄弟，显示下标越界了
2017年08月19日 05点08分
下面干货
2017年08月19日 05点08分
level 12
level 5
pan554576627
楼主
源数据工作表名称为 "sheet1",输出到工作表"sheet2",确认一下。
2017年08月19日 05点08分
回复
pt98
:我有几张表格，每张表格提取的内容不一样，每次提取后都会把提取的其他单元格内容覆盖了，想把所有提取的内容都粘贴到一张表格，但那代码会出现覆盖之前提取的问题
2017年08月19日 05点08分
pt98
:我有几张表格，每张表格提取的内容不一样，每次提取后都会把提取的其他单元格内容覆盖了，想把所有提取的内容都粘贴到一张表格，但那代码会出现覆盖之前提取的问题
@pan554576627 需要处理的工作表名称，还有输出工作表名称，最好上个图。可以写入数组然后输出就就不会覆盖。
2017年08月19日 05点08分
回复
pt98
:或者输出工作表名称给我
2017年08月19日 05点08分
pt98
:或者输出工作表名称给我
level 5
pan554576627
楼主
我有几张表格，每张表格提取的内容不一样，每次提取后都会把提取的其他单元格内容覆盖了，想把所有提取的内容都粘贴到一张表格，但那代码会出现覆盖之前提取的问题
2017年08月19日 05点08分
6
level 5
level 11
'删除sheet1,修改shee2名称为"输出表"
Option Explicit
Const outputsheetname = "输出表" '自己修改
Sub test()
Dim rng, sht, arr(1 To 1000, 1 To 100) '范围自己修改，如果巨量数据我用代码来自适应定义
For Each sht In Sheets
If sht.Name <> outputsheetname Then
For Each rng In Sheets(sht.Name).UsedRange
If rng.Value = "优秀" Then arr(rng.Row, rng.Column) = "优秀"
Next
End If
Next
With Sheets(outputsheetname)
.Cells.ClearContents
.[a1].Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End With
End Sub
2017年08月19日 05点08分
8
Option Explicit
Const outputsheetname = "输出表" '自己修改
Sub test()
Dim rng, sht, arr(1 To 1000, 1 To 100) '范围自己修改，如果巨量数据我用代码来自适应定义
For Each sht In Sheets
If sht.Name <> outputsheetname Then
For Each rng In Sheets(sht.Name).UsedRange
If rng.Value = "优秀" Then arr(rng.Row, rng.Column) = "优秀"
Next
End If
Next
With Sheets(outputsheetname)
.Cells.ClearContents
.[a1].Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End With
End Sub
level 13