Question

I need Excel VBA code that will help me automate the following:

I need to be able to copy and paste rows from a "master" worksheet to multiple newly created worksheets based on the data found in Column "K" with a header called "Skill". If Column K has any of the following "DEL-LPT-PRECISN", "DEL-LPT-XPS", "DEL-LT-ALIENWARE", "DEL-PC-AIO-OPTI", "DEL-PC-AIO-XPS", "DEL-PC-PRECISION" copy the entire row to newly created worksheet "Hard" If column "K" has anything else move it to newly created workshieet "Easy"

The column headers should be the same from the master to the 2 newly created wks "easy" and "hard"

The master worksheet changes daily and can have anywhere from 200 to 500 rows of data.

Thanks in advance for the help!

Answer 1

您可以使用高级过滤器轻松完成此操作。或者，您可以编写宏以针对每个条件进行过滤，然后进行相应的复制/粘贴。

或者您可以使用效率较低的代码。

假设：

您的工作簿上已经有3个名为“ Master”，“ Hard”，“ Easy”的工作表
每个工作表都有标题
所有标题都相同

Option Explicit

Sub MoveData()

Dim Master As Worksheet: Set Master = ThisWorkbook.Sheets("Master")
Dim Hard As Worksheet: Set Hard = ThisWorkbook.Sheets("Hard")
Dim Easy As Worksheet: Set Easy = ThisWorkbook.Sheets("Easy")

Dim String1, String2, String3, String4, String5, String6 As String
String1 = "DEL-LPT-PRECISN"
String2 = "DEL-LPT-XPS"
String3 = "DEL-LT-ALIENWARE"
String4 = "DEL-PC-AIO-OPTI"
String5 = "DEL-PC-AIO-XPS"
String6 = "DEL-PC-PRECISION"

Dim MyCell As Range

Application.ScreenUpdating = False
    For Each MyCell In Master.Range("K2:K" & Master.Range("K" & Master.Rows.Count).End(xlUp).Row)
        If MyCell.Text = String1 Or MyCell.Text = String2 Or MyCell.Text = String3 Or MyCell.Text = String4 Or MyCell.Text = String5 Or MyCell.Text = String6 Then
            Cell.EntireRow.Copy Hard.Range("A" & Hard.Range("A" & Hard.Rows.Count).End(xlUp).Offset(1).Row)
        Else
            Cell.EntireRow.Copy Easy.Range("A" & Easy.Range("A" & Easy.Rows.Count).End(xlUp).Offset(1).Row)
        End If
    Next MyCell
Application.ScreenUpdating = True

End Sub

Excel VBA Copy and Paste to Multiple Sheets Based on Conditions

1 个答案: