Excel VBA查找行，复制内容，粘贴到下一张表然后删除原始数据答案

【问题标题】：Excel VBA Find Row, copy contents, paste in next sheet then delete original dataExcel VBA查找行，复制内容，粘贴到下一张表然后删除原始数据
【发布时间】：2018-09-04 14:03:01
【问题描述】：

我正在努力识别工作表 1 中 A 列中非空白且 V 列中没有 Y 或 L 的行。然后我需要复制该行的内容，然后将值粘贴到打开的下一个工作表上的行。最后，我需要清除该行原始工作表上的内容。粘贴时我被卡住了。错误 1004 - 对象“_Worksheet”的方法“范围”失败。我很感激任何帮助。

Option Explicit
Option Compare Text
Sub EndMove()

Dim rowCount As Long, i As Long
Dim ws As Worksheet: Set ws = ActiveSheet
ws.Range("A11").Select
rowCount = ws.Cells(ws.Rows.Count, 1).End(xlUp).row
Application.ScreenUpdating = False: Application.EnableEvents = False
Call ShowAllRecords
For i = 11 To rowCount
    If ws.Range("V" & i) <> "y" And ws.Range("V" & i) <> "l" Then
        If ws.Range("A" & i) <> "" Then

Dim rowCount2 As Long, j As Long
Dim sRng As Range
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets(ActiveSheet.Index + 1)
Dim wAct As Worksheet
Dim lRow As Long
Dim End_Row As Long

Set wAct = ws
Set sRng = ws.Range("V" & i)

If Not IsDate("01 " & wAct.Name & " 2017") Or wAct.Name = "Dec" Then MsgBox "Not applicable for this sheet.": Exit Sub
If ActiveSheet.Index = ThisWorkbook.Worksheets.Count Then MsgBox "This is the last worksheet cannot move forward.": Exit Sub


wAct.unprotect

With ws2
    .unprotect

If rowCount2 = "1" Then

        For j = 11 To Rows.Count
        If .Range("A" & j) = "" Then
            End_Row = j
            Exit For
        End If
    Next j
Else

End If
    wAct.Range("A" & sRng.row & ":AD" & sRng.row + sRng.Rows.Count - 1).Copy
    .Range("A" & End_Row).PasteSpecial xlPasteValuesAndNumberFormats
    wAct.Range("A" & sRng.row & ":AD" & sRng.row + sRng.Rows.Count - 1).ClearContents
    .Range("A1000").Value = End_Row
    .protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
End With

wAct.protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True

Application.CutCopyMode = False


        End If
      End If
Next i
Application.EnableEvents = True: Application.ScreenUpdating = True
Call FilterBlanks
MsgBox "Move Complete"
End If
End Sub

【问题讨论】：

您能否快速录制宏并手动执行复制/粘贴，停止录制宏并转到 VB 编辑器 (Alt+F11) 并检查模块中的代码与您的代码的外观？
我得到了类似的代码，但结果相同。
你在哪一行得到错误？
.Range("A" & End_Row).PasteSpecial xlPasteValuesAndNumberFormats 是错误所在。
您需要确定要粘贴的工作表。

标签： vba excel

【解决方案1】：

您的代码中似乎没有任何行可以为 rowCount2 赋值。因此，当您在下面的代码中检查它时，它总是给出错误，因此跳过这部分

If rowCount2 = "1" Then

        For j = 11 To Rows.Count
        If .Range("A" & j) = "" Then
            End_Row = j
            Exit For
        End If
    Next j
Else

但该部分是必不可少的，因为它是唯一为 End_Row 赋值的部分。因此，当您尝试执行此操作时 .Range("A" & End_Row) End_Row 中没有任何内容。在该行设置断点并检查 End_Row 的 Locals 屏幕以确保它是这个。

【讨论】：