工作表拆分，请各位大神看看代码错在哪里

yyf92599

各位大神，今天学了一部分vba代码，在做练习的时候，执行错误，请给予帮忙

liulang0808

楼主在哪里搞的附件，类模块，模块，窗体一堆，也没有看到代码的
表格对应的也没有。
建议结合附件描述下吧

abc123281

VBA入门3期_第3天_练习.rar (26.67 KB, 下载次数: 3)

2020-2-5 00:21 上传

点击文件名下载附件

yyf92599

   
    Dim irows As Integer, i As Integer, k As Integer, sh As Worksheet, j As Integer
   
    irows = Worksheets("明细").Range("a1").CurrentRegion.Rows.Count
   
    For i = 2 To irows
        
        '判断 i 这行的地区，对应的工作表是否存在
        
        For j = 1 To Worksheets.Count
        
        If Worksheets(j).Name = Worksheets("明细").Cells(i, 2).Value Then
        
        '存在，就把数据拿过来
        
             k = sh.UsedRange.Rows.Count
        
             k = k + 1
        
             sh.Range("a" & k).Resize(1, 6).Value = Worksheets("明细").Range("a" & i).Resize(1, 6).Value
        
            GoTo 11
        
        End If
   
    Next j
   
    '不存在，新建
   
    Set sh = Worksheets.Add(after:=Worksheets(Worksheets.Count))
   
    sh.Name = Worksheets("明细").Cells(i, 2).Value
   
    sh.Range("a1").Resize(1, 6).Value = Worksheets("明细").Range("a1").Resize(1, 6).Value
   
    k = sh.UsedRange.Rows.Count
        
    k = k + 1
        
    sh.Range("a" & k).Resize(1, 6).Value = Worksheets("明细").Range("a" & i).Resize(1, 6).Value
11:

    Next i
   
End Sub

yyf92599

我一会儿放上去代码，请高手给予指点

chxw68

修改的楼主的代码。

1. Sub 拆分工作表()
   
2.   Dim irows As Integer, i As Integer, k As Integer, sh As Worksheet, j As Integer
   
3.   irows = Worksheets("明细").Range("a1").CurrentRegion.Rows.Count
   
4.   For i = 2 To irows
   
5.     For j = 1 To Worksheets.Count
   
6.       If Worksheets(j).Name = Worksheets("明细").Cells(i, 2).Value Then
   
7.         k = Worksheets(j).UsedRange.Rows.Count + 1
   
8.         Worksheets(j).Range("a" & k).Resize(1, 6).Value = Worksheets("明细").Range("a" & i).Resize(1, 6).Value
   
9.         GoTo 11
   
10.       End If
    
11.     Next j
    
12.     Set sh = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    
13.     sh.Name = Worksheets("明细").Cells(i, 2).Value
    
14.     sh.Range("a1").Resize(1, 6).Value = Worksheets("明细").Range("a1").Resize(1, 6).Value
    
15.     k = sh.UsedRange.Rows.Count + 1
    
16.     sh.Range("a" & k).Resize(1, 6).Value = Worksheets("明细").Range("a" & i).Resize(1, 6).Value
    
17. 11:
    
18.   Next i
    
19. End Sub

复制代码

chxw68

字典对楼主来说可能太高深了，修改的楼主的代码，方便楼主对照学习。

yyf92599

谢谢大家，受益非浅，原来学习了 ，不经常用就忘了。非常感谢