Excel 关于新建xls文件 新建sheet 合并sheet的VBA操作代码
2013-11-22 17:17
776 查看
Sub 合并一个文件夹下全部xls文件中sheet到一个xls的sheet()
workDir = ThisWorkbook.Path '当前xls文件所在的目录绝对路径
'MsgBox workDir, 0, "workDir"
bookname = ThisWorkbook.Name '当前xls文件名
'MsgBox bookname, 0, "bookname"
file = Dir(workDir & "\*.xls") 'workDir目录下第一个文件名
'MsgBox file, 0, "file"
Application.ScreenUpdating = False
Do While file <> ""
If file <> bookname Then
Set wk2 = Workbooks.Open(workDir & "\" & file)
For Each sht2 In wk2.Sheets
'MsgBox sht2.Name, 0, "Sheets(j).Name"
X = Range("A65536").End(xlUp).Row + 1
Cells(X, 1) = sht2.Name
sht2.Range("D2").Copy Cells(X, 2)
Next
wk2.Close False
End If
file = Dir '若第二次调用 Dir 函数,但不带任何参数,则函数将返回同一目录下的下一个 *.xls 文件
Loop
Application.ScreenUpdating = True
MsgBox "合并完毕!", vbInformation, "提示"
End Sub
---------------------------------------------------------------------------------------------
Sub 将一个sheet中的域名IP映射写到一个新的xls文件中,每个sheet对应一个域名()
Set sh = ActiveSheet
r = sh.Range("a65536").End(xlUp).Row'总共域名的个数
Workbooks.Add.SaveAs ThisWorkbook.Path & "\" & r & "个工作表的工作薄.xls"
For i = 1 To r
Set mySheet = ActiveWorkbook.Sheets.Add(after:=Worksheets(Worksheets.Count))
mySheet.Name = sh.Range("a" & i).Value '域名
mySheet.Range("d2") = sh.Range("b" & i).Value 'IP地址
'MsgBox sh.Range("a" & i).Value, 0, "aaa"
'MsgBox mySheet.Name, 0, "aaa"
mySheet.Range("a1:f1").EntireColumn.AutoFit '根据内容自动调整列宽
Next
'删除新建xls文件时默认的三个空sheet
Application.DisplayAlerts = False '删除时不用确认
Worksheets("sheet1").Delete
Worksheets("sheet2").Delete
Worksheets("sheet3").Delete
End Sub
----------------------------------------------------------------------------------------
-------------------------------------------------------------------------------------------
workDir = ThisWorkbook.Path '当前xls文件所在的目录绝对路径
'MsgBox workDir, 0, "workDir"
bookname = ThisWorkbook.Name '当前xls文件名
'MsgBox bookname, 0, "bookname"
file = Dir(workDir & "\*.xls") 'workDir目录下第一个文件名
'MsgBox file, 0, "file"
Application.ScreenUpdating = False
Do While file <> ""
If file <> bookname Then
Set wk2 = Workbooks.Open(workDir & "\" & file)
For Each sht2 In wk2.Sheets
'MsgBox sht2.Name, 0, "Sheets(j).Name"
X = Range("A65536").End(xlUp).Row + 1
Cells(X, 1) = sht2.Name
sht2.Range("D2").Copy Cells(X, 2)
Next
wk2.Close False
End If
file = Dir '若第二次调用 Dir 函数,但不带任何参数,则函数将返回同一目录下的下一个 *.xls 文件
Loop
Application.ScreenUpdating = True
MsgBox "合并完毕!", vbInformation, "提示"
End Sub
---------------------------------------------------------------------------------------------
Sub 将一个sheet中的域名IP映射写到一个新的xls文件中,每个sheet对应一个域名()
Set sh = ActiveSheet
r = sh.Range("a65536").End(xlUp).Row'总共域名的个数
Workbooks.Add.SaveAs ThisWorkbook.Path & "\" & r & "个工作表的工作薄.xls"
For i = 1 To r
Set mySheet = ActiveWorkbook.Sheets.Add(after:=Worksheets(Worksheets.Count))
mySheet.Name = sh.Range("a" & i).Value '域名
mySheet.Range("d2") = sh.Range("b" & i).Value 'IP地址
'MsgBox sh.Range("a" & i).Value, 0, "aaa"
'MsgBox mySheet.Name, 0, "aaa"
mySheet.Range("a1:f1").EntireColumn.AutoFit '根据内容自动调整列宽
Next
'删除新建xls文件时默认的三个空sheet
Application.DisplayAlerts = False '删除时不用确认
Worksheets("sheet1").Delete
Worksheets("sheet2").Delete
Worksheets("sheet3").Delete
End Sub
----------------------------------------------------------------------------------------
-------------------------------------------------------------------------------------------
相关文章推荐
- EXCEL用VBA代码拆分sheet为新EXCEL文件
- 关于Excel下通过VBA实现工作簿文件下工作表的合并
- Excel 文件复制操作vba代码
- 请问: vba, excel中打开多个xls文件, 搜索字符串,写入另一个sheet的问题
- Excel 文件复制操作vba代码
- VBA处理文件框架代码 【第五部分:Excel文件操作】
- 用VBA实现把多个Excel文件合并到一个Excel文件的多个工作表(Sheet)里
- 用ADO控件操作Excel的.xls文件的最详细的教程(2013.11.29首发)
- excel vba xml文件操作
- EXCEL计算公式之:excel跨文件、跨Sheet的合并计算公式
- Excel VBA-批量将多个sheet表另存为单独的工作薄文件
- SQL.MDB数据库记录Rs导出到Excel.Sheet中代码(VBA+VB.Net)
- C#代码对目录操作新建,删除 获取目录下文件列表等
- java poi导入EXCEL xls文件代码
- Excel 表格中根据某一列的值从另一个xls文件的对应sheet中查找包含其中一列的内容(有点拗口)
- ★★★Excel-VBA操作文件四大方法之三
- [例题]VB操作Excel (1)[用VB创建一个xls文件][并向里面写入一个数据]
- php中使用PHPExcel操作excel(xls)文件
- Excel-VBA文件操作1
- 利用Asp.net IO.File类完成文件新建复制删除操作(代码调试通过)(转)