Dim LSearchRow As Integer
Dim LCopyToRow As Integer
Dim wks As Worksheet
On Error GoTo Err_Execute
For Each wks In Worksheets
ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
Set wksCopyTo = ActiveSheet
wks.Rows(3).EntireRow.Copy wksCopyTo.Rows(3)
'Start search in row 4
LSearchRow = 4
'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 4
While Len(wks.Range("A" & CStr(LSearchRow)).Value) > 0
'If value in column E = "Mail Box", copy entire row to Sheet2
If wks.Range("AB" & CStr(LSearchRow)).Value = "Yes" And wks.Range("AK" & CStr(LSearchRow)).Value = "Yes" And wks.Range("BB" & CStr(LSearchRow)).Value = "Y" Then
'Select row in Sheet1 to copy
wks.Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
MsgBox "Copying Row"
'Paste row into Sheet2 in next row
wksCopyTo.Select
wksCopyTo.Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
wksCopyTo.Paste
MsgBox "Pasting Row"
'Move counter to next row
LCopyToRow = LCopyToRow + 1
'Go back to Sheet1 to continue searching
wks.Select
End If
LSearchRow = LSearchRow + 1
Wend
'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select
MsgBox "All matching data has been copied."
Next wks
Exit Sub
Err_Execute:
MsgBox "An error occurred."
你好
我有上面的代码,它基于其他地方给出的代码。在复制满足 if 语句中给定条件的行时,代码已经在我需要它的地方进行了调整,以便为每个现有工作表创建一个新工作表。我遇到的问题是:
- excel是否允许您在运行代码之前首先找出所有存在的工作表,这样您就不会循环往复?
- 我在处理一个工作表时给出的代码,在一段时间后不会执行,我不明白为什么?
- 当我在一个工作表上运行它时,它在 32,000 行后崩溃
任何人都可以帮忙吗?