使用VBA代码复制和粘贴工作簿中的工作表

时间:2013-06-28 14:22:16

标签: excel vba

尝试在VBA for Excel中编写宏以查看列表中每行数据的某一列中的值,如果该值为“是”,则将整个行复制并粘贴到不同的工作表中同一个工作簿。我们将这两张纸命名为“数据”和“最终”。我想要引用工作表,因此在运行代码时打开哪个工作表并不重要。我打算使用Do循环遍历一个数据表中的行,直到找到没有更多的条目,以及if语句来检查值。

我对如何从一张纸切换到另一张纸感到困惑。

如何专门引用不同表格中的单元格?

这是我想到的伪代码:

Do while DataCells(x,1).Value <> " "
    for each DataCells(x,1).Value="NO"
        if DataCells(x,2).Value > DataCells(x,3).Value or _
        DataCells(x,4).Value < DataCells(x,5).Value 
            'Copy and paste/insert row x from Data to Final sheet adding a new 
            'row for each qualifying row
        else
            x=x+1
        end
    else if DataCells(x,1).Value="YES"   
Loop
'copy and paste entire row to a third sheet
'continue this cycle until all rows in the data sheet are examined

1 个答案:

答案 0 :(得分:0)

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



Set sh = ThisWorkbook.Sheets("Data")
Set sh2 = ThisWorkbook.Sheets("Final")

lastrow1 = sh.Cells(Rows.Count, "A").End(xlUp).Row ' Replace "A" With column that has the most Rows
lastcolumn1 = sh.Cells(1, Columns.Count).End(xlToLeft).Column

With sh.Range(.Cells(1, 1), .Cells(lastrow1, lastcolumn1))

'Replace the number in the field section with your Columns number
    .AutoFilter , _
        Field:=1, _
        Criteria1:="yes"

    .Copy sh2.Range("A1")

End With

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

End Sub