VBA - IF a cell in column A = Value, then copy column B, C, D of same row to new worksheet

问题

I'm struggling to find any info that I can use on this. I searched heavily before coming here and any help would be greatly appreciated. I've got some basic VBA down, but this is a bit advanced to even know where to begin from scratch.

If a cell in Column A = Value, then copy columns B, C, D of source worksheet to columns A, B, C of a new worksheet.

Here's an example

Source worksheet

New worksheet

Thanks!

回答1:

You should ask the question more clearly so that we can help u. And every single step is easy. Just don't know what do you really need. You said you have some VBA done, so I assume you have the basics. For "column A = Value" Part, I assume you are asking if the value is contained in column A somewhere. For "copy column B, C, D to column A, B, C on a new worksheet." I assume you are copying the whole column. The following code gonna help you organize your thoughts and may get u start.

Sub YourMacr(ByVal compare_value)
    Dim arr As Variant, srcSheet As Worksheet, destSheet As Worksheet
    Set srcSheet = Sheets("xxxxxx")
    Set destSheet = Sheets("xxxxx")
    arr = srcSheet.Columns("A:A")
    If IsInArray(compare_value, arr) Then
        srcSheet.Columns("B:D").Copy
        destSheet.Columns("A:C").PasteSpecial xlPasteValues
    End If
End Sub

Private Function IsInArray(target As Variant, arr As Variant) As Boolean
    Dim ele As Variant
    On Error GoTo IsInArrayError:
    For Each ele In arr
        If ele = target Then
            IsInArray = True
            Exit Function
        End If
    Next ele
    Exit Function
IsInArrayError:
    On Error GoTo 0
    IsInArray = False
End Function

Based on your new description of you question, you want to copy paste the specific row to new sheet, not the whole data grid to sheet. Then, I prefer to use array to finished the task. The below code shall help you well. Hope this get u start

Public Sub YourMacr(ByVal compare_val)
    Dim srcSheet As Worksheet, destSheet As Worksheet

    Set srcSheet = ThisWorkbook.Sheets("your source sheet name ..........")
    Set destSheet = ThisWorkbook.Sheets("your new sheet name ...........")

    'Determine the last row in the source sheet, here I assume your data is on continues range and start from row 1
    Dim lastRow As Long
    lastRow = srcSheet.Range("A1").End(xlDown).Row

    'Loop through the column A, find which rows has value wanted
    ReDim idx_arr(1 To lastRow)
    Dim cnt As Integer
    cnt = 0
    For i = 1 To lastRow
        If srcSheet.Cells(i, 1).Value = compare_value Then
            cnt = cnt + 1
            idx_arr(cnt) = i
        End If
    Next

    If cnt = 0 Then Exit Sub

    For i = 1 To cnt
        destSheet.Cells(i, "A").Value = srcSheet.Cells(idx_arr(i), "B")
        destSheet.Cells(i, "B").Value = srcSheet.Cells(idx_arr(i), "C")
        destSheet.Cells(i, "C").Value = srcSheet.Cells(idx_arr(i), "D")
    Next i

    Dim targetRows(1 To 10000)

End Sub

来源：https://stackoverflow.com/questions/53623314/vba-if-a-cell-in-column-a-value-then-copy-column-b-c-d-of-same-row-to-new

标签

excel

vba