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

我正在使用下面的代码来尝试dynamic地将列表复制到另一个工作表。 它运行，但不是复制，而是删除源工作表上的所有列E，并且不会将任何内容移动到目标工作表。 我不确定发生了什么，有什么build议吗？

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循环中有一些错误（并且作为注释写太长了）。

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

其次，每次进入循环时都不需要声明variables（ 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来validation代码的某些部分时，它看起来像是没有运行的循环。 但是，没有踢出一个错误，我不知道为什么。

 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