Question

[在此处输入图像说明] [1]我想要在行中复制20-30个单元格的范围并将其粘贴到另一个工作表中。我制作了一个程序，但面临424和1004的错误。我试图解决这个错误但不能，所以我开始应用来自不同网站的不同提示。但找不到任何解决方案。我将感谢你的帮助。感谢

Sub CopyRows()

Dim LastRow As Integer, i As Integer, erow As Integer
Dim copyrange As Range

Sheet3.Select
'where is my data lies
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 4 To LastRow
    If cells(i, 1).Value = r Then
        ' condition that should satisfy

        copyrange = Range(Sheet3.cells(i, 8), sheete3.cells(i, 45)).Select
        Selection.Copy
        Worksheets("sheet2").Select
        erow = ActiveSheet.cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        ' erow is last empty row where i wants to copy data

        ActiveSheet.cells(erow, 3).Select
        ActiveSheet.Paste
        ActiveWorkbook.Save
    End If
Next i

End Sub

Answer 1

这里稍微清理了一下

Sub CopyRows()
Dim LastRow As Long, i As Long, erow As long
Dim copyrange As Range

/* where is my data lies
LastRow = Sheet3.Range("A" & Rows.Count).End(xlUp).Row
For i = 4 To LastRow
If Sheet3.cells(i, 1).Value = "r" Then         '<--- is r a string here ? put quotes if yes
/* condition that should satisfy

 erow = Sheet2.cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
/* erow is last empty row where i wants to copy data

Set copyrange = Sheet3.Range(cells(i, 8), cells(i, 45))
copyrange.Copy Destination:= Sheet2.cells(erow, 3)

ActiveWorkbook.Save
End If
Next i
End Sub

Answer 2

enter image description here 首先，作为一个拇指规则，始终定义和设置您的表格，它将帮助您避免将来出现许多可能的错误。

我不确定代码中的r是什么，在行中：

If Sheet3.cells(i, 1).Value = "r" Then

如果它是您之前定义的变量（不是您附加代码的一部分），那么它将起作用。如果您的意思是字母“r”（字符串），那么您需要在此答案中修改该行：

If .Cells(i, 1).Value = "r" Then

除此之外，请使用以下代码：

Option Explicit

Sub CopyRows()

Dim LastRow     As Integer, i   As Integer, erow    As Integer
Dim copyrange   As Range
Dim Sht3    As Worksheet, Sht2  As Worksheet

' always define and set your Sheets >> on the safe side

Set Sht3 = ThisWorkbook.Sheets("pending req")
Set Sht2 = ThisWorkbook.Sheets("recieve")

With Sht3
    'find last row with data
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

    For i = 4 To LastRow

        'If .Cells(i, 1).Value = r Then  ' condition that should satisfy (not sure what is r ? )
        ' use the line below to check if cell value equals "r"
        If .Cells(i, 1).Value = "r" Then

            Set copyrange = .Range(.Cells(i, 8), .Cells(i, 45))

            ' erow is last empty row where I want to copy data (assuming you meant Column A)
            erow = Sht2.Cells(Sht2.Rows.Count, 1).End(xlUp).Row + 1

            ' copy a range from one sheet to another without Selecting or activating
            copyrange.Copy Sht2.Cells(erow, 3)
        End If
    Next i

End With

ThisWorkbook.Save

End Sub

从一张纸上复制数据并将其从另一张相同的工作簿中过去

2 个答案: