利用<em>EXCEL</em>的宏新建工作簿，再将原工作簿中的一页内容复制到...-excel

在工作簿所在的文件夹里面新建工作簿，将下面代码粘贴入任意工作表的代码窗口中，按F5执行，就会把与此工作簿同一文件夹下e799bee5baa6e79fa5e98193e4b893e5b19e333的所有工作簿中工作表名为“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

代码如下(样本在附件中）

Sub test()
Dim t
Dim wb1 As Workbook, wb2 As Workbook
Dim fn As String, path As String
t = Timer
fn = Application.GetOpenFilename("Excel2003文件,*.xls,Excel2007文件,*.xlsx", , "请选择源文件", , False)
path = Left(fn, InStrRev(fn, "\"))
ftype = IIf(Right(fn, 1) = "x", ".xlsx", ".xls")
On Error GoTo nb
nn:
fb = InputBox("输入要保存的文件名，如：" & Chr(10) & "5月报表", "新工作簿名称")
If Len(fb) = 0 Then GoTo nn
Set wb1 = Workbooks.Open(fn, , False)
wb1.Worksheets(1).Copy     '复制源文件的第一个表。可以表名代e68a84e8a2ade79fa5e98193338替表的索引，如：
'--------------------------wb1.Worksheets("Sheet1").Copy
Set wb2 = ActiveWorkbook
wb2.SaveAs path & fb & ftype
wb1.Close
wb2.Close
MsgBox "处理完成。共用时" & Timer - t & "秒。" & Chr(10) & "新工作簿名为：" & fb & ftype & ",保存在" & path & "下。"
nb:
End Sub

1、以百建立副本的形式，在当前工作簿中度建立名称为“问xxx+当前日期(月和日)”的答工作表

Sheets("Sheet1").Select
Sheets("Sheet1").Copy After:=Sheets(sheets.count)
sheets(sheets.count).name="xxx" & date

2.把A2单元回格的内容改为xxx,格式不变答
range("a2")=xxx

这个不需要抄宏的，Excel本身自带复制工作表的功能。

1. 打开Excel，右击工作表的标签袭（即工作表下面的名称），选择“移动或复制”

2. 勾选“保留副本”，点确定。

这样就完成了复制，如果你用宏百的话，虽然只是点度一下按钮，但是在效率上明显不如用Excel自带的功能。

本文标签：excel 宏 sheet(1)excel宏数据导入多个表格(1)