Question

求一个excel宏：把多个excel工作薄中的指定sheet1表，复制到新的工作薄中

把多个excel工作薄中的指定sheet1表，复制到汇总工作薄中，并改名成sheetA，sheetB，sheetC。。。。
要求不要手动打开其他excel，因为比较多，太慢了。。。。

注意：多个excel中的sheet表名都一样。要把这些一样名字的sheet表复制到新的工作薄中，并改名

求个高手，谢谢~~~

Answer 1

在工作簿所在的文件夹里面新建工作簿，将下面代码粘贴入任意工作表的代码窗口中，按F5执行，就会把与此工作簿同一文件夹下的所有工作簿中工作表名为“sheet1"的表格复制到这个工作簿中来，并且新命名为"A" "B" "C" ……

Sub 复制工作簿中的工作表()
Application.ScreenUpdating = False
Dim FileName As String, wb As Workbook, fn As String, sht As Worksheet, k As Integer
k = 65
FileName = Dir(ThisWorkbook.Path & "\*.xls")
Do While FileName <> ""
If FileName <> ThisWorkbook.Name Then
fn = ThisWorkbook.Path & "\" & FileName
Set wb = GetObject(fn)
For Each sht In wb.Worksheets
If sht.Name = "sheet1" Then
sht.Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
ActiveSheet.Name = "sheet" & Chr(k)
k = k + 1
End If
Next
wb.Close False
End If
FileName = Dir
Loop
Application.ScreenUpdating = True
End Sub

追问

你好！谢谢，可以了。但是有个小问题，就是F5，我按了出现的定位。我用的是excel2010，能不能加个按钮，按一下就可以更新的？

我刚刚试了一下，发现运行一次后，再运行一次就会报错。。。。。
因为多个excel工作薄是固定的，每次都是这些工作薄，但是一段时间内容会变化一次，能否让每次复制粘贴过来的表覆盖前一次的表？

谢谢~~

追答

1. 按F5是在VBE窗口按，而不是在excel编辑窗口

2. 可以在EXCEL中插入个按钮，然后把　”Sub 复制工作簿中的工作表() end sub”　之间的代码复制到commond click事件中去。

3. 出错是因为EXCEL中已经存在那个工作表名了，再复制进去就重名了，可以用个变通的方法，每次复制前都把这个工作簿中的出了本工作表外的其他工作表都删除。

   你可以在K=65前面增加如下代码：
   

   Dim i As Integer

   Application.DisplayAlerts = False

   For i = ThisWorkbook.Worksheets.Count To 1 Step -1

       If Worksheets(i).Name <> Me.Name Then

           Worksheets(i).Delete

       End If

   Next

   Application.DisplayAlerts = True

4. 因为你要求用A/B/C…来命名工作表名，所以当超过26个工作表时，所以最好不要复制超过26个工作表。

追问

万分感谢！如果根据多个工作薄中的sheet表名都一样，但是工作薄名不一样，复制过来的sheet表如何改成和工作薄名一样？

追答

如果想改成拷过去的工作表名为原来的工作簿名，可以把ActiveSheet.Name = "sheet" & Chr(k)
这句改为：ActiveSheet.Name =wb.name

Answer 2

旺旺 理管天下