Vba 将行复制到其他工作表时出错

下面的代码在尝试将行复制到新工作表时出错。 excel工作表有3个工作表：信息数据导出、筛选器字符串名称、结果空白工作表

代码应该将筛选工作表中的子字符串与信息工作表中的主字符串相匹配。如果子字符串包含在主字符串中，它会将整行复制到结果工作表中。当它试图复制时出错

我可能会使过程过于复杂，非常感谢您的帮助。提前谢谢

错误：运行时错误“1004”： 应用程序定义或对象定义错误

Sub RoundedRectangle1_Click()

Dim info As Range
Dim filter As Range
Dim results As Range

Set info = Worksheets("Info").Cells(4, 5)
Set filter = Worksheets("Filter").Cells(2, 1)
Set results = Worksheets("Results").Cells(1, 1)

Dim i, j, k As Integer

i = 0
j = 0
k = 0

Do While info.Offset(i, 0) <> ""

If InStr(1, LCase(info.Offset(i, 0)), LCase(filter.Offset(k, 0))) <> 0 Then
info.Offset(i, 0).EntireRow.Copy results.Cells(j, 1)
i = i + 1
j = j + 1
k = 0
Else
If filter.Offset(k, 0) = "" Then
i = i + 1
k = 0
Else
k = k + 1
End If
End If
Loop

End Sub

---

之所以发生这种情况，是因为您的var J被声明为0。Cells0，1是无效的单元格。将J的值调整为1以解决此问题

Sub RoundedRectangle1_Click()

Dim info As Range
Dim filter As Range
Dim results As Range

Set info = Worksheets("Info").Cells(4, 5)
Set filter = Worksheets("Filter").Cells(2, 1)
Set results = Worksheets("Results").Cells(1, 1)

Dim i, j, k As Integer

i = 0
j = 1  'Error fixed here
k = 0

Do While info.Offset(i, 0) <> ""

If InStr(1, LCase(info.Offset(i, 0)), LCase(filter.Offset(k, 0))) <> 0 Then
info.Offset(i, 0).EntireRow.Copy results.Cells(j, 1)
i = i + 1
j = j + 1
k = 0
Else
If filter.Offset(k, 0) = "" Then
i = i + 1
k = 0
Else
k = k + 1
End If
End If
Loop

End Sub

---

如果您不介意粘贴到结果表中的行的顺序，您可以尝试以下方法：

Option Explicit

Sub main()
    Dim resultWS As Worksheet
    Dim subStrings As Variant, subString As Variant

    With Worksheets("Filter")
        subStrings = Application.Transpose(.Range("A2", .Cells(.Rows.count, 1).End(xlUp)))
    End With

    Set resultWS = Worksheets("Results")

    With Worksheets("Info")
        With .Range("E3", .Cells(.Rows.count, "E").End(xlUp))
            For Each subString In subStrings
                .AutoFilter field:=1, Criteria1:=subString
                If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then Intersect(.Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow, .Parent.UsedRange).Copy resultWS.Cells(.Rows.count, 1).End(xlUp).Offset(1)
            Next
        End With
        .AutoFilterMode = False
    End With
End Sub

---

最初，我将此设置用于复制结果。RangeA&j&:W&j=info.RangeA&I&:W&I。值，但它导致了相同的错误，不相关，但将I，j，k作为整数-注意只有k作为整数。i和j都是隐式变量。我很高兴这对你有用。如果可以，请将此标记为正确答案，供其他人参考。非常感谢。