如果VBA中有值,则复制单元格

时间:2017-05-05 06:52:54

标签: excel vba excel-vba

我想编写一个宏,如果它们包含一些值,则将1个单元格复制到另一个单元格。

表:
Table

期望:
Table i Want

到目前为止,我尝试了这个,但它只将最后一个单元格从sheet1复制到第2页的第一个单元格

Sub CopyBasedonSheet1()
    Dim i As Integer
    Dim j As Integer
    Sheet1LastRow = Worksheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row
    Sheet2LastRow = Worksheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row

    For j = 1 To Sheet1LastRow
        For i = 1 To Sheet2LastRow
            If Worksheets("Sheet1").Cells(j, 2).Value = "a" Then
                Worksheets("Sheet2").Cells(i, 1).Value = Worksheets("Sheet1").Cells(j, 1).Value
            Else
            End If
        Next i
    Next j
End Sub

2 个答案:

答案 0 :(得分:0)

你应该用一个循环来做,因为当你从第一张纸上有一行时,只有一个你要复制它的地方,而不是很多:

Sub CopyBasedonSheet1()
    Dim i As Integer
    Dim j As Integer
    Sheet1LastRow = Worksheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row

    i = 1
    For j = 1 To Sheet1LastRow
        If Worksheets("Sheet1").Cells(j, 2).Value = "a" Then
            Worksheets("Sheet2").Cells(i, 1).Value = Worksheets("Sheet1").Cells(j, 1).Value
            Worksheets("Sheet2").Cells(i, 2).Value = Worksheets("Sheet1").Cells(j, 2).Value
            i = i + 1
        End If
    Next j
End Sub

答案 1 :(得分:0)

或者你可以尝试一种不同的方法,这也更快......

Sub CopyData()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim x, y()
Dim i As Long, j As Long
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
x = ws1.Range("A1").CurrentRegion.Value
ReDim y(1 To Application.CountIf(ws1.Columns(2), "a"), 1 To 2)
j = 1
For i = 1 To UBound(x, 1)
    If x(i, 2) = "a" Then
        y(j, 1) = x(i, 1)
        y(j, 2) = x(i, 2)
        j = j + 1
    End If
Next i
ws2.Range("A:B").Clear
ws2.Range("A1").Resize(UBound(y, 1), 2).Value = y
End Sub