首页 > 解决方案 > 使用我的代码复制到下一个可用行

问题描述

使用我当前使用的代码,它将工作表 1 中的信息粘贴到工作表 2 顶行的工作表 2。接下来我想要的是使用相同的代码,但用于不同的单元格值,并将信息从工作表 1 复制到工作表 2,但在工作表 2 的下一个可用行中。

我一直在研究 excel 宏和 vba 一段时间,但我仍然遇到问题。我一直在努力不在我的 excel 代码中使用 select 和 activate ,但现在我的代码仍然有问题。我正在尝试尽可能多地自动化我的 excel 工作簿以便于使用。

Sub Copy()

Dim Cell As Range
Dim myRow As Long

myRow = 1
With Sheets("Sheet1")
    For Each Cell In .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)  
        If Cell.Value = "Tuck Chow" And Cell.Offset(0, 1).Value = "OPT" Then
            .Rows(Cell.Row).Copy Destination:=Sheets("Sheet2").Rows(myRow)
            myRow = myRow + 1
        End If
     Next Cell
End With
End Sub

标签: excelvba

解决方案


我会做这样的事情:

Sub Copy()

Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim newRow As Long

'setting sheets
Set sh1 = ThisWorkbook.Worksheets("Sheet1")
Set sh2 = ThisWorkbook.Worksheets("Sheet2")

With sh1
    For Each cel In .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
        If cel.Value = "Tuck Chow" And cel.Offset(0, 1).Value = "OPT" Then
            'getting new row on Sheet2
            If sh2.Cells(1, 1) = "" Then
                newRow = 1
            Else
                newRow = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1
            End If
            'copying
            cel.EntireRow.Copy Destination:=sh2.Cells(newRow, 1)
        End If
    Next cel
End With

'deselecting row
sh2.Cells(1, 1).Select

End Sub

推荐阅读