[已解决]合并sheet 页

小白白白白

将sheet页里面的数据合并到一个sheet 并且以后可以添加合并页的个数 比如这次合并两个 下次合并三个稍作改动就可以
For i = Worksheets.Count To 1 Step -1
        If Worksheets(i).Name = "ADDED_TOTAL" Or Worksheets(i).Name = "BADNESS_NEW" Or Worksheets(i).Name = "JION" Then
        Worksheets(i).Delete
        End If
这是删除sheet页的操作 我想模仿着个模式写的  有没有大神给解决下

最佳答案

月排行榜 / 总排行榜

grf1973

2015-10-16 16:52

Sub 合并()
    Dim Sh As Worksheet     '定义Sh为工作表类型的变量
    For Each Sh In Worksheets        '遍历所有工作表，设为Sh
        If InStr(Sh.Name, "ADDED") > 0 And Sh.Name <> ActiveSheet.Name Then  '如果工作表Sh的名字中包含“ADDED”字，并且不等于当前工作表名
            r1 = Sh.[a65536].End(3).row        '找到工作表Sh的A列有数据的最大行（用以确定要复制的数据区域）
            If r1 > 1 Then     '如果最大行大于1（表示工作内有数据）
                r = [b65536].End(3).row + 1       '当前表的A列最大行+1，设为r（数据粘贴的位置）
                Sh.Range("a2:L" & r1).Copy Cells(r, 3)        '工作表Sh有数据部分复制并粘贴到当前表的r行B列
                Cells(r, 2).Resize(r1 - 1, 1).Value = Sh.Name       '当前工作表的A列填充工作表Sh的名称（月份）
            End If
        End If
    Next       '找到下一张工作表Sh
End Sub

跳转到最佳答案楼层

小白白白白

求助 ·····

grf1973

1. Sub 合并()
   
2.     Dim Sh As Worksheet
   
3.     For Each Sh In Worksheets
   
4.         If Sh.Name <> ActiveSheet.Name Then
   
5.             r1 = Sh.[a65536].End(3).Row
   
6.             If r1 > 1 Then
   
7.                 r = [a65536].End(3).Row + 1
   
8.                 Sh.Range("a2:c" & r1).Copy Cells(r, 2)
   
9.                 Cells(r, 1).Resize(r1 - 1, 1).Value = Sh.Name
   
10.             End If
    
11.         End If
    
12.     Next
    
13. End Sub

复制代码

grf1973

请看附件。

小白白白白

grf1973 发表于 2015-10-16 11:08
请看附件。

效果是对的呢  能不能给一下注释啊 有的代码看不懂

小白白白白

grf1973 发表于 2015-10-16 11:08
请看附件。

还有一点我忘记说了   excel里面还有其他的表格  我要定向的合并  只把那几个 比如七月和八月合并到 一起  刚才我运行一下  把前面sheet页的东西全都复制到最后一个了{:181:}

grf1973

1. Sub 合并()
   
2.     Dim Sh As Worksheet     '定义Sh为工作表类型的变量
   
3.     For Each Sh In Worksheets        '遍历所有工作表，设为Sh
   
4.         If Sh.Name <> ActiveSheet.Name Then       '如果工作表Sh的名字不等于当前工作表名（"Total")
   
5.             r1 = Sh.[a65536].End(3).Row        '找到工作表Sh的A列有数据的最大行（用以确定要复制的数据区域）
   
6.             If r1 > 1 Then     '如果最大行大于1（表示工作内有数据）
   
7.                 r = [a65536].End(3).Row + 1       '当前表的A列最大行+1，设为r（数据粘贴的位置）
   
8.                 Sh.Range("a2:c" & r1).Copy Cells(r, 2)        '工作表Sh有数据部分复制并粘贴到当前表的r行B列
   
9.                 Cells(r, 1).Resize(r1 - 1, 1).Value = Sh.Name       '当前工作表的A列填充工作表Sh的名称（月份）
   
10.             End If
    
11.         End If
    
12.     Next       '找到下一张工作表Sh
    
13. End Sub

复制代码

grf1973

那你要说一下要合并工作表名的特征，比如带个“月"字的。。。。。。

1. Sub 合并()
   
2.     Dim Sh As Worksheet     '定义Sh为工作表类型的变量
   
3.     For Each Sh In Worksheets        '遍历所有工作表，设为Sh
   
4.         If InStr(Sh.Name, "月") > 0 Then    '如果工作表Sh的名字中包含“月”字
   
5.             r1 = Sh.[a65536].End(3).Row        '找到工作表Sh的A列有数据的最大行（用以确定要复制的数据区域）
   
6.             If r1 > 1 Then     '如果最大行大于1（表示工作内有数据）
   
7.                 r = [a65536].End(3).Row + 1       '当前表的A列最大行+1，设为r（数据粘贴的位置）
   
8.                 Sh.Range("a2:c" & r1).Copy Cells(r, 2)        '工作表Sh有数据部分复制并粘贴到当前表的r行B列
   
9.                 Cells(r, 1).Resize(r1 - 1, 1).Value = Sh.Name       '当前工作表的A列填充工作表Sh的名称（月份）
   
10.             End If
    
11.         End If
    
12.     Next       '找到下一张工作表Sh
    
13. End Sub
    

复制代码

grf1973

或者是第1个工作表到第5个工作表，第4句可以改成
If Sh.index>=1 and sh.index<=5  Then   

小白白白白

grf1973 发表于 2015-10-16 11:33
或者是第1个工作表到第5个工作表，第4句可以改成
If Sh.index>=1 and sh.index

可不可以指定名字呢  因为以后合并的工作表名字有规律的 都是“ADDED_xxxx”
合并到“ADDED_TOTAL”