返回目录:excel表格制作
完整复制一个工作薄至另一个Excel文件内的方法:
所需材料:Excel 2007示例。
一、以下步骤百被复制的工作薄称之为工作薄1,需要复制到的工作薄称之为工作薄2,首先双击打开工度作薄1。
二、在工作薄1窗口内,点击左上角“Office按钮”,下拉菜单内点击“打开”版。
三、选中工作薄2,点击“打开”。
四、这时切换至工作薄1,右键点击左下角“Sheet1”,菜单内点击“移动或复制权工作表”。
五、点击工作薄列表,然后选中工作薄2.
六、最后点击“确定”即可把工作薄1的第一页复制入工作薄2。
将每知一个工作表保存为一个工作薄。道
打开工作表》Alt+F11》粘贴下列回代码》运行代码。答
Sub
SaveSheet()
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
ws.Copy
ActiveWorkbook.SaveAs Filename:= _
ThisWorkbook.Path & "\" &
ws.Name, FileFormat:=xlOpenXMLWorkbook _
, Password:="",
WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
End Sub
原始数据所在工作簿包含多个格式相同的工作表,只不过每个工作表内容不同,比如说不同人名的工作表数据或者不同部门填写的数据;
在原始数据同目录下新建一个工作簿,建立两个工作表,名称分别为“首页”和“合并汇总表”;
按Alt+F11进入VBA代码编辑和调e799bee5baa6e997aee7ad94e4b893e5b19e366试界面;
根据下图提示,插入一个模块;
将下述代码粘贴到模块空白处:
Sub CombineSheetsCells()
Dim wsNewWorksheet As Worksheet
Dim cel As Range
Dim DataSource, RowTitle, ColumnTitle, SourceDataRows, SourceDataColumns As Variant
Dim TitleRow, TitleColumn As Range
Dim Num As Integer
Dim DataRows As Long
DataRows = 1
Dim TitleArr()
Dim Choice
Dim MyName$, MyFileName$, ActiveSheetName$, AddressAll$, AddressRow$, AddressColumn$, FileDir$, DataSheet$, myDelimiter$
Dim n, i
n = 1
i = 1
Application.DisplayAlerts = False
Worksheets("合并汇总表").
DeleteSet wsNewWorksheet = Worksheets.Add(, after:=Worksheets(Worksheets.Count))
wsNewWorksheet.Name = "合并汇总表"
MyFileName = Application.GetOpenFilename("Excel工作薄 (*.xls*),*.xls*")
If MyFileName = "False" Then
MsgBox "没有选择文件!请重新选择一个被合并文件!", vbInformation, "取消"
Else
Workbooks.Open Filename:=MyFileName
Num = ActiveWorkbook.Sheets.Count
MyName = ActiveWorkbook.Name
Set DataSource = Application.InputBox(prompt:="请选择要合并的数据区域:", Type:=8)
AddressAll = DataSource.Address
ActiveWorkbook.ActiveSheet.Range(AddressAll).Select
SourceDataRows = Selection.Rows.Count
SourceDataColumns = Selection.Columns.Count
Application.ScreenUpdating = False
Application.EnableEvents = False
For i = 1 To Num
ActiveWorkbook.Sheets(i).Activate
ActiveWorkbook.Sheets(i).Range(AddressAll).Select
Selection.Copy
ActiveSheetName = ActiveWorkbook.ActiveSheet.Name
Workbooks(ThisWorkbook.Name).Activate
ActiveWorkbook.Sheets("合并汇总表").Select
ActiveWorkbook.Sheets("合并汇总表").Range("A" & DataRows).Value = ActiveSheetName
ActiveWorkbook.Sheets("合并汇总表").Range(Cells(DataRows, 2), Cells(DataRows, 2)).Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _:=False, Transpose:=False
DataRows = DataRows + SourceDataRows
Workbooks(MyName).Activate
Next i
Application.ScreenUpdating = True
Application.EnableEvents = True
End If
Workbooks(MyName).Close
End Sub
在“首页”工作表中按下图示范插入一个窗体控件并指定宏为插入的代码名称;
点击“首页”工作表中插入的按钮,根据提示,浏览到原始数据工作簿;
下一步,用鼠标选择要合并的数据范围;
点击确定按钮,待代码运行完毕后,所有的数据就都合并到了“合并汇总表”中;
选中全部数据区域,执行自动筛选。然后选择其中一个字段,选择“空白”和标题内容;
然后将筛选出来的无用行鼠标右键删除,再删除A列整列即可。
1.需要把多个excel表都放在同一个文件夹里面,并在这个文件夹里面新建一个excel。如图所示:
2.用microsoft excel打开新建的excel表,并右键单击sheet1,找到“查看代码”,单击进去。进去之后就看到了宏计算界面。如图所示:
3.然后把下面这些宏计算的代码复制进去,然后找到工具栏上面的“运行”下的“运行子过程/用户窗e5a48de588b67a686964616f332体”,代码如下,如图所示:
Sub 合并当前目录下所有工作簿的全部工作表()
Dim MyPath, MyName, AWbName
Dim Wb As Workbook, WbN As String
Dim G As Long
Dim Num As Long
Dim BOX As String
Application.ScreenUpdating = False
MyPath = ActiveWorkbook.Path
MyName = Dir(MyPath & "\" & "*.xls")
AWbName = ActiveWorkbook.Name
Num = 0
Do While MyName <> ""
If MyName <> AWbName Then
Set Wb = Workbooks.Open(MyPath & "\" & MyName)
Num = Num + 1
With Workbooks(1).ActiveSheet
.Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
For G = 1 To Sheets.Count
Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)
Next
WbN = WbN & Chr(13) & Wb.Name
Wb.Close False
End With
End If
MyName = Dir
Loop
Range("B1").Select
Application.ScreenUpdating = True
MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下:" & Chr(13) & WbN, vbInformation, "提示"
End Sub
4.运行之后,等待10秒针左右,等运行完毕,就是合并完成之后,会有提示,点确定就可以了。查看合并后的数据,有5000多行,就是同一个文件夹里面17个excel表数据合并后的结果。效果如图所示。