Question

我使用以下代码尝试将列表动态复制到另一个工作表。它运行，但它不是复制，而是删除源工作表上的所有列E，并且不会将任何内容移动到目标工作表。我不知道发生了什么，有什么建议吗？

Option Explicit

Sub findCells()

Dim topCell As String
Dim leftCell As String
Dim refCell As Range
Dim sht As Worksheet
Dim lastRow As Long
Dim i As Long

Set refCell = ActiveCell

topCell = refCell.End(xlUp).Value
leftCell = refCell.End(xlToLeft).Value

MsgBox topCell
MsgBox leftCell

Worksheets(topCell).Activate

Set sht = Worksheets(topCell)

lastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
MsgBox lastRow

For i = 1 To lastRow
    Dim cellVal As String
    Dim altCounter As Integer
    altCounter = 31
    Cells(i, 5).Value = cellVal
    If leftCell = cellVal Then
    Dim crange As Range
    altCounter = altCounter + 1
     Let crange = "A" & i & ":" & "G" & i
     Range(crange).Copy Worksheets("Summary").Range("A" & altCounter & ":" & "G" & altCounter)
    End If
Next i

End Sub

Answer 1

这不是完整的答案，但是你的For i = 1 To lastRow循环中有一些错误（并且写作评论太长了。）

首先，使用您定义的Cells对象完全限定Range和sht。

其次，每次进入循环时都无需声明变量（cellVal，altCounter和crange）。

第三，要设置范围，此Let crange = "A" & i & ":" & "G" & i会导致错误，您需要使用Set crange = .Range("A" & i & ":" & "G" & i)。

第四，你的代码中没有给出cellVal的值，所以我认为Cells(i, 5).Value = cellVal中的语法应该是cellVal = .Cells(i, 5).Value

Dim cellVal As String
Dim altCounter As Long '<-- use Long instead of Integer
Dim crange As Range

With sht        
    altCounter = 31
    For i = 1 To lastRow
        cellVal = .Cells(i, 5).Value
        If leftCell = cellVal Then
            altCounter = altCounter + 1
            Set crange = .Range("A" & i & ":" & "G" & i)
            crange.Copy Worksheets("Summary").Range("A" & altCounter & ":" & "G" & altCounter)
        End If
    Next i
End With

Answer 2

对于评论来说，这也太长了，但感谢Shai Rado - 这是一个完整的答案，而且代码在我实施后仍然有效。

然而，在我编辑成下面之后，它停止了工作。它不会引发错误，只是不像以前那样复制和粘贴行。

我不确定发生了什么，但是当我使用MsgBox来验证代码的某些部分时，看起来它是不起作用的循环。但是，如果没有错误，我就不知道为什么。

Option Explicit

Sub findCells()

Dim topCell As String
Dim leftCell As String
Dim refCell As Range
Dim sht As Worksheet
Dim lastRow As Long
Dim i As Long
Dim cellVal As String
Dim altCounter As Long
Dim crange As Range
Dim rangeToDelete As Range

Set rangeToDelete = Worksheets("Summary").Cells(31, "A").CurrentRegion
    rangeToDelete.Value = ""

Set refCell = ActiveCell

topCell = refCell.End(xlUp).Value
leftCell = refCell.End(xlToLeft).Value

Set sht = Worksheets(topCell)

lastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row

With sht
    .Range("A1:G1").Copy Worksheets("Summary").Range("A31:G31")
    altCounter = 31
    For i = 1 To lastRow
        cellVal = Cells(i, 5).Value
        If leftCell = cellVal Then
            altCounter = altCounter + 1
            Set crange = .Range("A" & i & ":" & "G" & i)
            crange.Copy Worksheets("Summary").Range("A" & altCounter & ":" & "G" & altCounter)
        End If
    Next i
End With

End Sub

如何使用for循环VBA Excel有条件地复制和粘贴行

2 个答案: