Question

我正在失去理智，但我无法看到我在这里做错了什么，但是每次运行这个宏我都会在列标题和实际数据之间留下一个空行。返回的数据是正确的，但我无法理解为什么我在顶部获得额外的一行！

拜托，我能拥有一双新鲜的眼睛吗？

由于

Dim LSearchRow As Long
Dim LCopyToRow As Long
Dim wks As Worksheet
On Error GoTo Err_Execute

For Each wks In Worksheets

LSearchRow = 4
LCopyToRow = 4

ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
Set wksCopyTo = ActiveSheet
wks.Rows(3).EntireRow.Copy wksCopyTo.Rows(3)

While Len(wks.Range("A" & CStr(LSearchRow)).Value) > 0

    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

        Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
        Selection.Copy


        wksCopyTo.Select
        wksCopyTo.Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
        wksCopyTo.Paste

        'Move counter to next row
        LCopyToRow = LCopyToRow + 1
        'Go back to Sheet1 to continue searching
        wks.Select
    End If
    LSearchRow = LSearchRow + 1
Wend

Application.CutCopyMode = False
Range("A3").Select
MsgBox "All matching data has been copied."
Next wks
    Exit Sub
Err_Execute:
    MsgBox "An error occurred."

Answer 1

拜托，我能拥有一双新鲜的眼睛吗？

也许是因为你错过了Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select之前的工作表名称？

代码执行此行后

ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)

当前工作表是新工作表，因此它将引用新创建的工作表。之后wks.Select将控件返回到主页。

所以改为

wks.Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select

此外，您的整个子记录都可以重写为（ UNTESTED ）

Option Explicit

Sub Sample()
    Dim LSearchRow As Long, LCopyToRow As Long
    Dim wks As Worksheet, wksCopyTo As Worksheet

    On Error GoTo Err_Execute

    For Each wks In Worksheets
        LSearchRow = 4: LCopyToRow = 4

        With wks
            ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
            Set wksCopyTo = ActiveSheet
            .Rows(3).EntireRow.Copy wksCopyTo.Rows(3)

            While Len(Trim(.Range("A" & LSearchRow).Value)) > 0
                If .Range("AB" & LSearchRow).Value = "Yes" And _
                   .Range("AK" & LSearchRow).Value = "Yes" And _
                   .Range("BB" & LSearchRow).Value = "Y" Then

                    .Rows(LSearchRow).Copy wksCopyTo.Rows(LCopyToRow)

                    LCopyToRow = LCopyToRow + 1
                End If
                LSearchRow = LSearchRow + 1
            Wend
        End With

        MsgBox "All matching data has been copied."
    Next wks

    Exit Sub

Err_Execute:
    MsgBox "An error occurred."
End Sub

Answer 2

当Siddharth说时可能是因为你之前错过了工作表名称

您的代码将wksCopyTo设置为ActiveSheet，对wks上的数据进行测试，然后从ActiveSheet中进行选择和复制。稍后在while循环中选择wks - 这就是为什么只有第一行为空

将这五行改为

wks.Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).copy wksCopyTo.Rows(CStr(LCopyToRow) & ":" & Str(LCopyToRow))

在标题和数据之间添加空白行

2 个答案: