将数据复制到新工作表(选项卡)

时间:2014-12-16 22:12:12

标签: excel vba

      Sheet1                            Sheet2 (output)
      A    B   C                        A    B   C
1   Name1 100  May                1   Name1 100 May        
2   Name2 200  June               2   Name2 200 June
3   Name3      Oct                3   Name3     Oct
4   Name4 300                     4   Name4 300
5   Name5       

我想读取列B和C中的值。如果存在2个中的任何值,则将该行拉入同一Excel工作簿的新工作表或制表符中。如果列B和C为空白,则跳过该行并移至下一行。

2 个答案:

答案 0 :(得分:0)

以下是评论中带有解释的代码

<强>测试

Sub checkNcopy()
'Checking the last populated row
lastRow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

counter = 2

'Copying the variable Names
for i=1 to 3
Worksheets("Sheet2").Cells(1, i) = Worksheets("Sheet1").Cells(1, i)
Next 

For i = 2 To lastRow

'Checking if one of the two columns B and C are populated or not
If Not IsEmpty(Worksheets("Sheet1").Cells(i, 2)) Or Not IsEmpty(Worksheets("Sheet1").Cells(i, 3)) Then

'If one of the two variables are populated then copying the data from sheet1 to sheet2
for j=1 to 3
 Worksheets("Sheet2").Cells(counter, j) = Worksheets("Sheet1").Cells(i, j)
Next
counter = counter + 1
End If

Next

End Sub

答案 1 :(得分:0)

您可以在有效范围内使用.CurrentRegion()来获取与整个表格对应的范围,以及.Copy()方法:

Sub CopyData()

Worksheets("Sheet1").Range("A1").Activate

ActiveCell.CurrentRegion.AutoFilter Field:=2, Criteria1:="<>"

ActiveCell.CurrentRegion.AutoFilter Field:=3, Criteria1:="<>"

ActiveCell.CurrentRegion.Copy Worksheets("Sheet2").Range("A1")

End Sub

稍微更合适,但可读性较低的版本是:

Sub CopyDataxxx()

    Dim TargetRange As Range

    Worksheets("Sheet1").Activate
    Range("A1").Activate

    Set TargetRange = ActiveCell.CurrentRegion

    With TargetRange
        .AutoFilter Field:=3, Criteria1:="<>"
        .Copy Worksheets("Sheet2").Range("A1")
        .AutoFilter 'switches off AutoFilter
    End With

End Sub