在For Loop和Pasting中复制行到新工作表

时间:2013-06-12 12:43:37

标签: excel vba copy row range

我在根据条件复制/粘贴行时遇到问题。

Dim lastrow1 As Long
Dim lastcolumn1 As Long
Dim Distance As Long
Distance = 14
Set sh = ThisWorkbook.Sheets("Sample Address Database")
Set sh2 = ThisWorkbook.Sheets("Workspace")
lastrow1 = sh.Cells(Rows.Count, "A").End(xlUp).row
lastcolumn1 = sh.Cells(1, Columns.Count).End(xlToLeft).Column

Dim L As Long
For L = 2 To lastrow1
    If _
    sh.Cells(L, Distance).Value <= CDbl(cboRadius.Value) Then
        sh.Range("A" & L & ":" & lastcolumn1 & L).Copy _
        Destination:=sh2.Range("A" & L)
    End If
Next

cboRadius.Value是userform中的一个数字(该行没有问题。)

每当我尝试运行此代码时,我得到一个“运行时错误'1004':对象'_Worksheet'的方法'范围'失败,黄色箭头指向目标行。问题是什么?< / p>

修改 Ed Heywood-Lonsdale建议我改变

sh.Range("A" & L & ":" & lastcolumn1 & L).Copy _

sh.Range("A" & L & ":A" & lastcolumn1 & L).Copy _

现在只有A列,或者我将其更改为B,C,D等正在被复制。我认为问题在于它可能没有注册lastcolumn1而L是列/行编号而是将它们设为一个值,从而导致范围故障。

2 个答案:

答案 0 :(得分:2)

尝试添加&#34; A&#34;在定义要复制的范围时:

sh.Range("A" & L & ":" & lastcolumn1 & L)

变为

sh.Range("A" & L & ":A" & lastcolumn1 & L)

答案 1 :(得分:1)

我只是使用内置的Excel过滤器过滤您的数据,然后复制结果,而不是尝试遍历每一行。

但是 如果你想要循环行:

要使用Range功能,您需要使用列字母而不是列号。

这里有2个选项。使用

Chr(lastcolumn1 + 64) 

而不是lastcolumn1。缺陷是这只适用于列Z之前的列,如果没有if语句和更多代码,它将不适用于双字母列。如下所示应该适用于列ZZZ

If lastcolumn1> 52 Then
    strColumnLetter = Chr(Int((lastcolumn1- 1) / 52) + 64) & Chr(Int((lastcolumn1- 27) / 26) + 64) & Chr(Int((lastcolumn1- 27) Mod 26) + 65)
ElseIf lastcolumn1> 26 Then
    strColumnLetter = Chr(Int((lastcolumn1- 1) / 26) + 64) & Chr(Int((lastcolumn1- 1) Mod 26) + 65)
Else
    strColumnLetter = Chr(lastcolumn1+ 64)
End If

但你也可以使用

strColumnLetter = Split(Cells(1, lastcolumn1).EntireColumn.Address(False, False), ":")(0)

OR

strColumnLetter = Left(Replace(Cells(1, lastcolumn1).Address(1, 0), "$", ""), InStr(1, Replace(Cells(1, lastcolumn1).Address(1, 0), "$", ""), 1) - 1) 

OR

strColumnLetter = Left(Cells(1, lastcolumn1).Address(1, 0), InStr(1, Cells(1, lastcolumn1).Address(1, 0), "$") - 1)

因为这将适用于Excel将保留的列数。

如果您不想将数字转换为列,则最后一个选项Letter将获得一系列单元格,因为Cells函数可以接受参数的列号。

sh.Range(cells(L,1), cells(L,lastcolumn1))

我再次建议只使用标准的内置过滤器功能来过滤掉你不想要的数据然后只复制剩下的东西。这只是为了增加更多选择。

如果您提供一些示例信息,我可以写一个sub,它将为您执行过滤器复制粘贴,但我不知道您的数据是如何设置的。

这是一个应该根据您的原始问题工作的示例:

Sub FilterAndCopy()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Dim sh As Worksheet, sh2 As Worksheet
Dim lastrow1 As Long
Dim lastcolumn1 As Long
Dim Distance As Long
Distance = 14


Set sh = ThisWorkbook.Sheets("Sample Address Database")
Set sh2 = ThisWorkbook.Sheets("Workspace")

lastrow1 = sh.Cells(Rows.Count, "A").End(xlUp).Row
lastcolumn1 = sh.Cells(1, Columns.Count).End(xlToLeft).Column

With sh
    .Range(.Cells(1, 1), .Cells(lastrow1, lastcolumn1)).AutoFilter , _
    field:=Distance, _
    Criteria1:="<=" & CDbl(151), _
    Operator:=xlAnd

    .Range(.Cells(2, 1), .Cells(lastrow1, lastcolumn1)).Copy _
    sh2.Range("A2")

End With

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub