时间戳

首页 > 解决方案 > 使用循环和 if 条件将数据复制并粘贴到另一个工作表

excel - 使用循环和 if 条件将数据复制并粘贴到另一个工作表

问题描述

以下代码似乎运行顺利，但没有任何内容复制到所需页面

Sub a2()


Sheets.Add.Name = "25 degree"
Sheets("25 degree").Move after:=Sheets("data")


Dim x As Long

For x = 2 To 33281

If Cells(x, 1).Value = 25 Then

    Cells("x,1:x,2:x,3:x,4:x,5:x,6").Copy
     Worksheets("25 degree").Select
     ActiveSheet.Paste

End If

Next x

End Sub

标签： excelvba

解决方案

我强烈建议不要使用.Select或根据如何避免在 Excel VBA 中使用 SelectActiveSheet为每个对象指定工作表。Cells()

Option Explicit

Public Sub DoSomeCoypExample()
    Dim wsSource As Worksheet
    Set wsSource = ThisWorkbook.ActiveSheet
        'better define by name
        'Set wsSource = ThisWorkbook.Worksheets("source sheet")

    Dim wsDestination As Worksheet
    Set wsDestination = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets("data")) 'add at the correct position and set it to a variable
    wsDestination.Name = "25 degree" 'so you can use the variable to access the new added worksheet.

    Dim iRow As Long
    For iRow = 2 To 33281 'don't use fixed end numbers (see below if you meant to loop until the last used row)
        If wsSource.Cells(iRow, 1).Value = 25 Then
            With wsSource
                .Range(.Cells(iRow, 1), .Cells(iRow, 6)).Copy Destination:=wsDestination.Range("A1")
                'this line will copy columns 1 to 6 of the current row
                'note you need to specify the range where you want to paste
                'if this should be dynamic see below.
            End With
        End If
    Next iRow
End Sub

如果你想循环直到最后使用的行，你可以用类似的东西得到它

Dim LastRow As Long
LastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row 'last used row in column A

如果您想粘贴到目标工作表中的下一个空闲行而不是固定范围Destination:=wsDestination.Range("A1")，您可以使用与上述相同的技术来查找下一个空闲行：

Dim NextFreeRow As Long
NextFreeRow = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row + 1

因此，您可以在粘贴目标中使用它：
Destination:=wsDestination.Range("A" & NextFreeRow)

推荐阅读