使用VBA将整行数据从一个工作表复制到另一个工作表时遇到问题

Question

我正在尝试组织我的支出，我的excel文档中的第一张表包含了我的所有购买。我在A栏中有“日期”，B栏有“费用类别”，C栏有“详细信息”，D栏有“费用”。如果B栏有“气体”字样，我想将整行复制到第2页。

我试图查找这个问题，并从以下链接找到代码：https://www.extendoffice.com/documents/excel/3723-excel-move-row-to-another-sheet-based-on-cell-value.html#a1

我试图更新代码以反映我的数据，但我刚开始学习VBA并且得到“下标超出范围”错误和“I =工作表（”Sheet1“）。UsedRange.Rows.Count被突出显示为黄色。

这是我目前的代码，基于将行复制到其他工作表的网站代码：

Sub MoveRowBasedOnCellValue()

Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("Sheet1").UsedRange.Rows.Count
J = Worksheets("Sheet2").UsedRange.Rows.Count
If J = 1 Then
  If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 
  0 Then J = 0
End If
Set xRg = Worksheets("Sheet1").Range("B1:B" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "Gas" Then
    xRg(K).EntireRow.Copy Desitination:=Worksheets("Sheet2").Range("A" & J + 1)
    J = J + 1
End If
Next
Application.ScreenUpdating = True


End Sub

任何帮助是极大的赞赏！

Answer 1

我相信你需要改变

For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "Gas" Then
    xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
    J = J + 1
End If

对于：

For each KCell in xRg
If KCell.Value = "Gas" Then
    KCell.EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
    J = J + 1
End If
Next KCell

（循环遍历xRg中的每个单元格）