这类代码能套用循环语句解决吗？麻烦帮写下

ken1991518

类似下面代码能用循环语句套用吗？不一样的只是红色字体部分，假设有100个人，如果避免把这段过程复制100次会出现vba错误提示过程太过大？麻烦写下出来，自己小白一个不太懂啊，谢了！   

代码：

    Windows("123.xlsm").Activate
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$K$1000").AutoFilter Field:=11, Criteria1:="张三"
    Range("J1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Copy
    Windows("数据-张三.xlsx").Activate
    Range("A1").Select
    ActiveSheet.Paste

    Windows("123.xlsm").Activate
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$K$1000").AutoFilter Field:=11, Criteria1:="李四"
    Range("J1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Copy
    Windows("数据-李四.xlsx").Activate
    Range("A1").Select
    ActiveSheet.Paste


    Windows("123.xlsm").Activate
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$K$1000").AutoFilter Field:=11, Criteria1:="王五"
    Range("J1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Copy
    Windows("数据-王五.xlsx").Activate
    Range("A1").Select
    ActiveSheet.Paste

jiangxiaoyun

能啊           闷闷闷闷闷闷闷

ken1991518

jiangxiaoyun 发表于 2017-9-21 14:44
能啊           闷闷闷闷闷闷闷

能写给我看看吗，谢了兄弟

uynayna

赋值到数组里面，循环。

ken1991518

uynayna 发表于 2017-9-21 14:51
赋值到数组里面，循环。

能写出来给我看看吗，我小白一个啊，谢了

naolew

要养成上付附件的好习惯。有附件，写代码的人要少走很多弯路的。

microyip

1.     Dim vName As Variant, nName As Integer
   
2.     Dim wSH As Worksheet
   
3.    
   
4.     vName = Split("张三,李四,王五", ",")
   
5.     With Windows("123.xlsm").ActiveSheet
   
6.         For nName = 0 To UBound(vName)
   
7.             .AutoFilter
   
8.             .Range("$A$1:$K$1000").AutoFilter Field:=11, Criteria1:=vName(nName)
   
9.             With .Range("J1")
   
10.                 .Resize(.End(xlDown).Row, .End(xlToLeft).comlum - .Column + 1).Copy
    
11.             End With
    
12.             Windows("数据-" & vName(nName) & ".xlsx").Activate
    
13.             Range("A1").Select
    
14.             ActiveSheet.Paste
    
15.         Next
    
16.     End With

复制代码

microyip

    Dim vName As Variant, nName As Integer
    Dim wSH As Worksheet
   
    vName = Split("张三,李四,王五", ",")
    With Windows("123.xlsm").ActiveSheet
        For nName = 0 To UBound(vName)
            .AutoFilter
            .Range("$A$1:$K$1000").AutoFilter Field:=11, Criteria1:=vName(nName)
            With .Range("J1")
                .Resize(.End(xlDown).Row, .End(xlToLeft).comlum - .Column + 1).Copy
            End With
            Windows("数据-" & vName(nName) & ".xlsx").Activate
            Range("A1").Select
            ActiveSheet.Paste
        Next
    End With

microyip

的确，有附件比较方便点，否则，回复代码都是需要审核，比较麻烦

ken1991518

microyip 发表于 2017-9-21 15:10
的确，有附件比较方便点，否则，回复代码都是需要审核，比较麻烦

不好意思，已上传了