简体   繁体   中英

Excel VBA Copy Sheet/Line

I have 2 Master Sheets based on 2 conditions of location. I import this data from an Excel Workbook into a worksheet on the Master Sheet Workbook. I think it would be better if I was able to scan the first column (A for example) and if the row meets a certain condition it would move the entire row to the respective Master Sheet just below the current data. If it meets condition B it goes to the other master sheet. I can then use Remove Duplicates in Excel to filter the data. My current code is below and I am fairly new to VB Automation. Any ideas on what kind of code I could use to select and move the rows based on criteria into 2 seperate master worksheets?

Sub Copy_DataCDN()
Sheets("CDNDataDump").Range("A2:AC10000").Copy _
Sheets("CDN").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Sheets("CDN").Select

As you suggested, this can be done by looping through the cells in your condition column (in the example code it's column A).

Here's the example code for you to modify.

Sub MoveToSheets()
    Dim dataSource As Worksheet: Set dataSource = ThisWorkbook.Sheets(1)
    Dim dataTargetA As Worksheet: Set dataTargetA = ThisWorkbook.Sheets(2)
    Dim dataTargetB As Worksheet: Set dataTargetB = ThisWorkbook.Sheets(3)
    Dim dataSourceRange As Range: Set dataSourceRange = dataSource _
    .Range("A1:A" & dataSource.Cells(dataSource.Rows.Count, "A").End(xlUp).Row)

    For Each Cell In dataSourceRange
        'Test 1 - I'm checking if the cell value is a number as an example.
        If IsNumeric(Cell.Value) = True Then
            dataTargetA.Range("A" & Rows.Count).End(xlUp).Offset(1).EntireRow.Value _
            = Cell.EntireRow.Value
        'Test 2 - Checking if the cell value is "e".
        ElseIf Cell.Value = "e" Then
            dataTargetB.Range("A" & Rows.Count).End(xlUp).Offset(1).EntireRow.Value _
            = Cell.EntireRow.Value
        End If
    Next
End Sub

In the For Each Cell In dataSourceRange loop you can have as many conditions as you need. You could have more sheets to paste to as well.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM