VBA代码-拆分工作表

15234162570

您好，附件工作表---总表，以“规格”为准进行拆分；

我如下代码运行不了，帮忙修改一下，谢谢；

代码如下：

Sub 拆分工作表()

Dim i, j, k As Integer



For j = 2 To Sheets.Count

    For i = 2 To Sheet1.Range("a65536").End(xlUp).Row

        If Sheet1.Range("d" & i) = Sheets(j).Name Then

           k = Sheets(j).Range("a65536").End(xlUp).Row


           Sheet1.Range("d" & i).EntireRow.Copy Sheets(j).Range("a" & k + 1)

        End If

      Next

  Next

  End Sub

3190496160

拆分问题，去看看这帖子吧，下载就能用
http://club.excelhome.net/thread-1535151-1-1.html

wbperfect

1. Sub 拆分工作表()
   
2.     Dim i, j, k As Integer
   
3.     For j = 2 To Sheets.Count
   
4.         For i = 2 To Sheet1.Range("a65536").End(xlUp).Row
   
5.             If Sheet1.Range("d" & i).Value Like Sheets(j).Name Then
   
6.                 k = Sheets(j).Range("a65536").End(xlUp).Row
   
7.                 Sheet1.Range("d" & i).EntireRow.Copy Sheets(j).Range("a" & k + 1)
   
8.             End If
   
9.         Next
   
10.     Next
    
11. End Sub

复制代码

wbperfect

不建议这样拆   可以直接根据总表 按照D列拆分后新建命名会好点