Question

我尝试根据某些条件将数据从一个工作簿复制到另一个工作簿。宏将写入目标工作簿，如下所示。但是，当我运行代码时，我得到一个＆＃34;运行时错误9.脚本超出范围错误＆＃34;。任何人都可以帮我看一下代码吗？感谢!!!!

Sub sbCopyRangeToAnotherSheetFromLastRow()
    Dim s1Sheet As Worksheet, s2Sheet As Worksheet
    Dim source As String
    Dim target As String
    Dim path As String
    Dim path1 As String
    Dim rngSource As Range
    Dim rngTargetStart As Range
    Dim rngTargetStart2 As Range
    Dim j As Long, k As Long, erow As Integer

    source = "PB Position"  'Source Tab Name
    path_source = "C:\Temp\MIS RISK REPORT.xlsm"
    target = "Input - Trailing 12 week" 'Target tab Name
    Application.EnableCancelKey = xlDisabled

    Set s1Sheet = Workbooks.Open(path_source).Sheets(source)
    Set s2Sheet = ThisWorkbook.Sheets(target)
    Set rngSource = Range(s1Sheet.Range("A8"), s1Sheet.Cells.SpecialCells(xlCellTypeLastCell))
    Set rngTargetStart = s2Sheet.Range("C" & Rows.Count).End(xlUp).Offset(1)

    k = rngSource.Rows.Count

    For j = 8 To k
        If (rngSource.Cells(j, "O") = "K1" Or rngSource.Cells(j, "O") = "K2" Or rngSource.Cells(j, "O") = "G2") And rngSource.Cells(j, "AH") <> 1 Then
            rngSource.Cells(j, "A").EntireRow.Select
            Selection.Copy
            Worksheets(target).Select
            erow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Row
            ActiveSheet.Cells(erow, "C").Select
            ActiveSheet.Paste
            ActiveWorkbook.Save
            Application.CutCopyMode = False
        End If
    Next j
End Sub

Answer 1

我准备写第三条评论，所以我会把所有的建议都归结为答案，希望这些清理可以解决你的问题。

1）您的Set rngSource行应该是

s1Sheet.Range("A8", s1Sheet.Cells.SpecialCells(xlCellTypeLastCell))

这可能不是问题，但它实际上是针对你想要的范围！

2）你也应该避免使用Select（见this previous SO question）。相反，首先计算erow，然后使用

rngSource.Cells(j, "A").EntireRow.copy destination:= ActiveSheet.Cells(erow,"C")

除非您无法将整行粘贴到列C中的单元格中！它应该是

rngSource.Cells(j, "A").EntireRow.copy destination:= ActiveSheet.Cells(erow,"A")

这可能是您的超出范围错误来自

的地方

根据critera

1 个答案: