[已解决]请求赐教！合并工作表为工作 ...

松儿

hwc2ycy 发表于 2013-1-27 21:05

合并后的工作薄（表）中，没有新增一列为A列，引用工作表标签的日期到新增加的A列。

hwc2ycy

1. Sub 合并()
   
2.     Dim wb As Workbook
   
3.     Dim i&, addr$, j&, LastRow&, FirstRow&
   
4.     Application.ScreenUpdating = False
   
5.     With ThisWorkbook
   
6.         For i = 1 To .Worksheets.Count
   
7.             Debug.Print .Worksheets(i).Name,
   
8.             If .Worksheets(i).Name Like "*.*.*" Then
   
9.                 .Worksheets(i).UsedRange.Copy
   
10.                 Exit For
    
11.             End If
    
12.         Next
    
13.         Set wb = Workbooks.Add
    
14.         Cells(Rows.Count, 2).End(xlUp).PasteSpecial
    
15.         LastRow = Cells(Rows.Count, 2).End(xlUp).Row
    
16.         Range("a5:a" & LastRow) = .Worksheets(i).Name
    
17.         For j = i + 1 To .Worksheets.Count
    
18.             If .Worksheets(j).Name Like "*.*.*" Then
    
19.                 FirstRow = Cells(Rows.Count, 2).End(xlUp).Row + 1
    
20.                 addr = Replace(.Worksheets(j).UsedRange.Address, "$A$1", "$A$5")
    
21.                 .Worksheets(j).Range(addr).Copy
    
22.                 Cells(FirstRow, 2).PasteSpecial
    
23.                 LastRow = Cells(Rows.Count, 2).End(xlUp).Row
    
24.                 Range("a" & FirstRow & ":a" & LastRow) = .Worksheets(j).Name
    
25.             End If
    
26.         Next
    
27.     End With
    
28.     Application.ScreenUpdating = True
    
29.     MsgBox "工作表已经合并到" & wb.Name & ",请保存"
    
30. End Sub
    

复制代码

千岩一页

看不懂哈，怎么还有代码的，求师傅