1

我失去了理智，但我看不出我在这里做错了什么，但是每次运行这个宏时，我都会在列标题和实际数据之间不断得到一个空白行。返回的数据是正确的，但我不明白为什么我会在顶部多出一行！

请给我一双新鲜的眼睛好吗！

谢谢

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."
4

2 回答 2

2

请给我一双新鲜的眼睛好吗！

也许是因为您之前缺少工作表名称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
于 2012-05-14T18:00:43.190 回答
0

Siddharth 说可能是正确的，因为您之前缺少工作表名称...

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

将这五行更改为

wks.Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).copy wksCopyTo.Rows(CStr(LCopyToRow) & ":" & Str(LCopyToRow))
于 2012-05-14T19:48:48.953 回答