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

我失去了我的想法，但我不明白我在这里做错了什么，但每次运行这个macros，我一直在列标题和实际数据之间得到一个空白的行。 正在返回的数据是正确的，但我不明白为什么我在顶部获得额外的行！

请给我一双新鲜的眼睛！

谢谢

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之前的工作表名称Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select

代码执行这一行之后

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

当前工作表是新工作表，因此它将引用新创build的工作表。 稍后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在他说Maybe时是正确的， 因为你之前缺less工作表名…

你的代码将wksCopyTo设置为ActiveSheet ，在wks上testing数据，然后从ActiveSheetselect和复制。 稍后在while循环中selectwks – 这就是为什么只有第一行是空白的

改变这五条线

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