如何实现批量提制并且重新命名？

abcmotoe6

我有一个工作表，名称是“生产量统计表”，我想按每个月的天数批量复制，并且以日期重新命名，想请高手教我如何实现？谢谢再谢谢！

zjcat35

你上传附件吧！！

abcmotoe6

新建 Microsoft Excel 工作表 (2).rar (9.63 KB, 下载次数: 8)

2012-2-26 20:31 上传

点击文件名下载附件 谢谢！

windimi007

abcmotoe6 发表于 2012-2-26 20:31
谢谢！

请测试！如果原来表中有同名的，先删除后再添加，不知道是否符合要求？{:171:}

1. Option Explicit
   
2. Sub fuzhi()
   
3.     Dim i As Long
   
4.     Dim ed As Byte
   
5.     Application.ScreenUpdating = False
   
6.     ed = Day(DateSerial(Year(Date), Month(Date) + 1, 0))
   
7.     For i = 1 To Sheets.Count
   
8.         If Sheets(i).Name <> "生产量统计表" Then
   
9.             Application.DisplayAlerts = False
   
10.             Sheets(i).Delete
    
11.             Application.DisplayAlerts = True
    
12.         End If
    
13.     Next i
    
14.     For i = 1 To ed
    
15.         Sheets("生产量统计表").Copy , Sheets(Sheets.Count)
    
16.         ActiveSheet.Name = i
    
17.     Next i
    
18.     Sheets("生产量统计表").Select
    
19.     Application.ScreenUpdating = True
    
20. End Sub
    

复制代码

zjcat35

1. Sub a()
   
2.     Dim i As Byte, j As Byte, m As Byte
   
3.     j = Day(DateAdd("m", 1, Now) - Day(Now))
   
4.     For i = 1 To j
   
5.         m = Sheets.Count
   
6.         Sheets("生产量统计表").Copy after:=Sheets(m)
   
7.         ActiveSheet.Name = i
   
8.     Next i
   
9. End Sub

复制代码

windimi007

abcmotoe6 发表于 2012-2-26 20:31
谢谢！

再提供一个不删除原表的代码。

1. Option Explicit
   
2. Sub fuzhi()
   
3.     Dim i As Long
   
4.     Dim ed As Byte
   
5.     On Error Resume Next
   
6.     Application.ScreenUpdating = False
   
7.     ed = Day(DateSerial(Year(Date), Month(Date) + 1, 0))
   
8.     For i = 1 To ed
   
9.         Sheets("生产量统计表").Copy , Sheets(Sheets.Count)
   
10.         ActiveSheet.Name = i
    
11.     Next i
    
12.     For i = 1 To Sheets.Count
    
13.         If Sheets(i).Name Like "生产量统计表 *" Then
    
14.             Application.DisplayAlerts = False
    
15.             Sheets(i).Delete
    
16.             Application.DisplayAlerts = True
    
17.         End If
    
18.     Next i
    
19.     Sheets("生产量统计表").Select
    
20.     Application.ScreenUpdating = True
    
21. End Sub

复制代码

abcmotoe6

太谢谢各位了！万分感谢！

abcmotoe6

谢谢，我是一个新手，能不能请6楼的高手给我一个详细的操作过程，太谢谢了

zjcat35

把6楼的代码复制进去就好！