Excel VBA根据条件复制并粘贴到多张图纸

Excel VBA根据条件复制并粘贴到多张图纸,excel,vba,Excel,Vba,我需要Excel VBA代码,该代码将帮助我自动执行以下操作: 我需要能够根据K列中的数据,将主工作表中的行复制并粘贴到多个新创建的工作表中,标题为Skill。如果K列有以下任意一项DEL-LPT-PRECISN、DEL-LPT-XPS、DEL-LT-ALIENWARE、DEL-PC-AIO-OPTI、DEL-PC-AIO-XPS、DEL-PC-PRECISION,则将整行硬拷贝到新创建的工作表中,如果K列有其他内容,则轻松将其移动到新创建的工作表中 列标题应该是相同的,从主到2个新创建的作品容

我需要Excel VBA代码,该代码将帮助我自动执行以下操作:

我需要能够根据K列中的数据,将主工作表中的行复制并粘贴到多个新创建的工作表中,标题为Skill。如果K列有以下任意一项DEL-LPT-PRECISN、DEL-LPT-XPS、DEL-LT-ALIENWARE、DEL-PC-AIO-OPTI、DEL-PC-AIO-XPS、DEL-PC-PRECISION,则将整行硬拷贝到新创建的工作表中,如果K列有其他内容,则轻松将其移动到新创建的工作表中

列标题应该是相同的,从主到2个新创建的作品容易和难

主工作表每天都在变化,可以有200到500行数据


提前感谢您的帮助

您可以使用高级过滤器轻松完成此操作。或者,您可以编写宏来筛选每个条件,并相应地复制/粘贴

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

假设:

您的工作簿上已经有3张名为Master、Hard和Easy的工作表 每张纸都有页眉 所有标题都相同
你好,艾尔比!非常感谢你花时间帮我解决问题。我执行了您的代码并收到一个编译错误:变量未定义错误消息,单元格在第一个单元格中突出显示。EntireRow.Copy Hard.Range……尝试将单元格定义为Range。晚上好!谢谢你的回复。我将单元格定义为范围,现在我得到运行时错误91对象或块变量未设置,以下高亮显示的“cell.EntireRow.Copy Easy.RangeA&Easy.RangeA&Easy.Rows.Count.EndxlUp.Offset1.Row”已更新。搜索范围仅定义为一个单元格。在Master.RangeK2:K&…中为每个迈塞尔更改。。。。。对不起
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