保存指定工作表为工作簿文件
 
1、指定的单一工作表
 
如果需要将工作簿中的工作表单独保存为一个工作簿文件，可以使用 Worksheet 对象的 Copy 方法，将指定的工作表复制到一个新建的工作簿。
 
Sub test()
    On Error GoTo line
    ActiveSheet.Copy  '复制工作表为工作簿
    ActiveWorkbook.Close savechanges:=True, Filename:="d:\123.xlsx" '保存当前工作簿即可
    Exit Sub
line:
    ActiveWorkbook.Close False
End Sub
 
2、所有工作表保存为工作簿
 
'方法一：
Sub test1()
    Application.ScreenUpdating = False '屏幕不更新
    Dim i As Integer
    Dim j As Integer
    Dim str As String
    j = Worksheets.Count
    For i = j To 1 Step -1
        Worksheets(i).Copy
    	str = ActiveWorkbook.Sheets(1).Name   '将工作簿名称改为工作表名称
        ActiveWorkbook.SaveAs Filename:="D:\data\" & str & ".xlsx"
        ActiveWorkbook.Close savechanges:=True
    Next
	Application.ScreenUpdating = True
End Sub

'方法二:
Sub test()
Dim sht As Worksheet
Application.ScreenUpdating = False
For Each sht In Sheets
    sht.Copy
    ActiveWorkbook.SaveAs Filename:="d:\data\" & sht.Name & ".xlsx"
    ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
End Sub

Sub addRe()
    '1.此脚本用于根据sheet1中的第一列从第三行开始的数据新建工作簿并重命名
    '2.复制第一列和对应的列的值
    '3.调整新建工作簿的列宽
    ScreenUpdating = False '关闭屏幕刷新
    Dim sCount As Long     '列数
    Dim sCol As Long       '行数

    Dim rnG1 As Range '第一列区域
    Dim rnG2 As Range '第二列区域
    Dim rn As Range   '第一列的开头
    Dim arr1() '第一列的数组（静态）
    Dim arr2() '第二列的数组（动态）

    Set rn = Sheet1.Cells(2, 1) '读出新工作簿要用的第一列的开头
    Set rnG1 = Sheet1.Range(rn, rn.End(xlDown)) '读出新工作簿要用的第一列的区域
        sCount = Sheet1.Range("A2").CurrentRegion.Columns.Count - 1 '读出行数
        sCol = rnG1.Rows.Count '读行数
        arr1 = rnG1 '第一列
    Dim arrName() '名字数组
    ReDim arrName(sCount - 1) '调整数组大小
    
    For i = 1 To sCount
        
        Set rn = Sheet1.Cells(2, i + 1) '读出新工作簿要用的第二列的开头
        Set rnG2 = Sheet1.Range(rn, rn.End(xlDown)) '读出新工作簿要用的第二列的区域
        arr2 = rnG2 '转换为数组
        Sheet1.Activate
        Sheets.Add after:=ActiveSheet '新建工作簿
        
        ActiveSheet.Name = Sheet1.Cells(2, i + 1) '工作簿重命名
        arrName(i - 1) = ActiveSheet.Name '记录新建工作簿的名称
        ActiveSheet.Range(Cells(2, 1), Cells(sCol, 1)) = arr1 '第一列赋值
        ActiveSheet.Range(Cells(2, 2), Cells(sCol, 2)) = arr2 '第二列赋值
        
        Columns("A:B").EntireColumn.AutoFit '调整选中所有新建的工作簿AB列的列宽
    Next i

    Sheet1.Activate '回到Sheet1工作簿
    ScreenUpdating = True '打开屏幕刷新
End Sub


 
在我写完上面的代码之后很快就被啪啪打脸了：
 
下面这个简单高效，结果一样还保留了格式。。。
 
Sub fz()
    Dim a As Byte
    For a = 2 To Cells(2, Columns.Count).End(xlToLeft).Column
        With Sheets.Add(after:=Sheets(Sheets.Count))
            .Name = Worksheets(1).Cells(2, a)
            Worksheets(1).Select
            Worksheets(1).Columns(1).Copy .Range("a1")
            Worksheets(1).Columns(a).Copy .Range("b1")
        End With
    Next a
End Sub
 
 
 
 
 
表格内容大概是这样的：
 
 
 
 
 
 
时间
J2-01(JD0280)_位移(mm)
J2-02(JD0267)_位移(mm)
J2-03(JD0282)_位移(mm)
J2-04(JD0275)_位移(mm)
2019-07-30
-0.14
-0.24
-0.2
-0.26
2019-07-29
-0.14
-0.24
-0.2
-0.26
2019-07-28
-0.14
-0.23
-0.19
-0.26
2019-07-27
-0.14
-0.23
-0.19
-0.26
2019-07-26
-0.13
-0.23
-0.19
-0.26
2019-07-25
-0.13
-0.23
-0.18
-0.25
2019-07-24
-0.13
-0.22
-0.18
-0.25
2019-07-23
-0.13
-0.22
-0.18
-0.25
2019-07-22
-0.13
-0.22
-0.17
-0.24
2019-07-21
-0.13
-0.22
-0.17
-0.25
2019-07-20
-0.12
-0.21
-0.16
-0.24
2019-07-19
-0.12
-0.21
-0.15
-0.24
2019-07-18
-0.12
-0.2
-0.14
-0.23
2019-07-17
-0.12
-0.21
-0.16
-0.24
2019-07-16
-0.12
-0.2
-0.14
-0.23
2019-07-15
-0.11
-0.19
-0.12
-0.22
2019-07-14
-0.11
-0.19
-0.11
-0.21
2019-07-13
-0.1
-0.18
-0.11
-0.21
2019-07-12
-0.11
-0.19
-0.12
-0.21
2019-07-11
-0.11
-0.19
-0.12
-0.22
2019-07-10
-0.11
-0.19
-0.11
-0.21
2019-07-09
-0.1
-0.18
-0.1
-0.21
2019-07-08
-0.1
-0.18
-0.1
-0.21
2019-07-07
-0.1
-0.18
-0.1
-0.21
2019-07-06
-0.1
-0.18
-0.1
-0.21
结果是这样的：
 

新建工作簿
 
这节内容介绍如何应用VBA自动创建工作簿，并修改部分内容后保存关闭。和创建工作表类似，创建工作簿仍然使用add方法。下面是一个较为完整的创建例子：
 
Sub addnewbook()
    Dim i As Integer
    Dim shtname As Variant
    Dim newbook As Workbook
    Dim arr As Variant
    Dim sht As Worksheet
    
    shtname = Array("a", "b", "c", "d") '新建工作簿中工作表名称
    arr = Array("1", "2", "3", "4", "5", "6") '工作表中内容
    
    Set newbook = Workbooks.Add '创建工作簿
    With newbook
        .ActiveSheet.Name = shtname(0)
        For i = 2 To 4
            .Sheets.Add after:=.Sheets(newbook.Sheets.Count) '创建工作表
            .ActiveSheet.Name = shtname(i - 1) '更改工作表名字
        Next
        
        For Each sht In .Worksheets
            sht.Range("a1").Resize(1, 6) = arr '修改工作表中内容
        Next
        .SaveAs Filename:="D:\data\1.xlsx" '设置保存路径
        .Close savechanges = True '确定可以更改
    End With
End Sub

VBA单元格、工作表、工作簿
 
 
一、单元格
 
注意：
 
单元格不仅包括值，还包括格式等信息，虽然很多时候结果是等同的，为避免出错，如果只想引用单元格的值，使用.value方法，尤其在使用字典时，比如：dic(range(“a1”).value) = range(“b1”).value；赋值：range(“a1”).value = 100
直接输入单元格，表示的是当前激活工作表的单元格，如果想表示非激活工作表单元格，需要在单元格前面加上工作表对象，比如sheets(“sheet_name”).range(“a1”)；这里工作表也是一样的，默认为激活工作簿下的工作表，如需表示其他工作簿工作表，需要在前面加上工作簿对象；未避免出错，一般我们都会设置工作簿对象，逐级引用下面的单元格对象。比如：
set wb = thisworkbook
with wb.worksheets("sheet_name")
	.range("a1").value = "a1"
	.cells(2,1).value = "a2"
	[a3].value = "a3"
end with
 
 
1. range表示
 
1.1 单个单元格：
 
range("a1")
'或者
range("ab200")
 
1.2. 范围：
 
1.2.1. 指定范围
 
'如果指向同一个工作表，这三个是等价的，表示a1:b10范围
range("a1:b10")
range("a1","b10")
range(range("a1"),range("b10"))
 
1.2.2. 行或者列
 
'行表示：
range("a1").entirerow	
range("1:1")		
range("2:2,5:5")
rows(1)	
rows("1:1")
'列表示：
range("a:a")		
columns("a:a")	
columns(1)	
range("a1").entirecolumn
 
1.2.3. 当前区域和使用区域
 
sheet1.usedrange	'使用区域
sheet1.range("a1").currentregion		'单元格a1所在连续区域
 
1.2.4. 交集和合集
 
intersect(range("a1:a10"),range("2:3"))		'该交集结果：range("a2:a3")
rg = range("a1")
rng = range("a2")
set rng = union(rng,rg)		'union单元格取并集，该并集结果：range("a1:a2")；注意：对象要使用set赋值。
 
1.2.5 向range传入excel单元格自定义名称
 
'还可以向range传入excel单元格自定义名称
'是的，可以向多个单元格赋值同一个数值
range("input") = 1
 
运行效果如下图：
 
 1.2.6 定位
 
range("a1:b10").specialcells(xlCellTypeBlanks)		'定位空白单元格
sheets(sheet_name).specialcells(xlcelltypevisible)		'定位可见单元格
 
specialcells更多参数请参考VBA帮助手册。
 
其中，entirerow和entirecolumn,currentregion,union,specialcells同样适用于[]和cells表示使用，下面不再重复赘述。
 
2. 其他表示方法
 
2.1 cells单个单元格
 
'都表示a1单元格
cells(1,1)
cells(1,"a")
'下面这种表示，range("a2:b6")一共有10个单元格，如果想cells传入一个数值，表示从左上到右下的位置，下面表示为range("a4")单元格
range("a2:b6").cells(5)
'表示range("a5")单元格
rang("a2:b6").cells(4,1)
''Range("a2:b6")只有10个单元格，cells传入参数实际是从单元格左上角开始计算的。可以忽略区域大小
Range("a2:b6").Cells(12) = "第12个单元格"		
 
range使用cells方法效果如图：
 
 2.2 []表示方法
 
[a1]	'range("a1")
[a1:b10]	'range("a1:b10")
 
2.3 活动单元格
 ActiveCell，如果在select选中单元格情况下，也可以使用selection
 active也适用于工作表，工作表，图表等，表示活动对象。比如活动sheet：activesheet
 
3. end方法
 
等同于excel中“ctrl”+方向键定位。range(“b3”).end(xlup) 向上定位：range(“b1”)
 end可以传入参数’上’:‘xlup’,‘下’:‘xldown’,‘左’:‘xltoleft’,‘右’:‘xltoright’
 也可以传入数字1，2，3，4分别代表上下左右。
 注意：end只能在连续单元格跳转到最后一个单元格，range(“b10”).end(xlup)，如果b5单元格为空，只会跳转到b6单元格，跟excel一样的。
 
4. 格式
 
4.1 判断单元格是否包含批注
 
If Range("A1").Comment Is Nothing Then
'插入"hello"批注：
ActiveCell.AddComment ("Hello") 
 
4.2 单元格是否为公式单元格
 
if range("a1").hasformula = True then		
 
这点可以结合公式填充语句filldown（excel鼠标公式单元格右下角双击公式填充）一起使用，先判断单元格是否为公式单元格，再调用filldown。如下代码：
 
Sub formula_filldown()
	dim i ,max_row,max_col as long
	max_col = activesheet.[a1].end(xltoright).column
	max_row = activesheet.usedrange.rows.count
	'假设第一行是标题，第二行是内容
	for i = 1 to max_col
		'判断第二行单元格是否包含公式，有公式自动填充
		if cells(2,i).hasformula then range(cells(2,i),cells(max_row,i)).filldown
	next
End Sub
 
4.3 是否为合并单元格
 
range("a1").mergecells = true
'合并单元格
range("a1:b1").merge
 
4.4 格式刷&选择性粘贴
 
格式刷
 
sub paste_formats()
   Range("a6:at6").Copy
   Range("a7:at7").PasteSpecial Paste:=xlPasteFormats
end sub
 
选择性粘贴为值
 
With ActiveSheet.UsedRange
    .Copy
    .PasteSpecial Paste:=xlPasteValues
    '复制后要清空剪切板，不然再操作复制，会出错。
    Application.CutCopyMode = False		
End With
 
5. 排序
 
key表示排序字段，第一个有值的单元格，非标题。order排序方法，升序：xlAscending，降序：xlDescending；可以设置多个排序字段，key-order依次写就可以了。
 
Sub sort()
Range("a2:b12").sort key1:=Range("a2"), order1:=xlDescending, _
key2:=Range("b2"), order2:=xlAscending
End Sub
 
6. 筛选
 
Sheet1.UsedRange.AutoFilter field(筛选的列),criteria1(筛选条件，可以使用比较运算符),operator(第二筛选条件),visibledropdown(是否显示箭头True：显示)
 范围也可以指定为数组array，比如：
 range(“a1”).currentregion.autofilter field:=3,criteria1:=array(…)
 示例图片：
 
 
Sub aa()
'筛选地区-广东
Sheet1.UsedRange.AutoFilter field:=1, Criteria1:="广东"
'筛选水果-苹果
Sheet1.UsedRange.AutoFilter field:=2, Criteria1:="苹果"
'筛选销量-大于1
Sheet1.UsedRange.AutoFilter field:=3, Criteria1:=">1"
End Sub
 
结果如下图：
 
 
7. 隐藏行或列
 
'隐藏C和E列
Range("C:C,E:E").EntireColumn.Hidden = True

'取消行列隐藏
Cells.EntireColumn.Hidden = False 
Cells.EntireRow.Hidden = False
 
8. 删除与插入
 
'clear是清除内容与格式

'清除工作表中的内容。
cells.clear

'或者也可以这样
sheet1.usedrange.clear	

'如果你只想清楚单元格内容的话，使用.clearcontents方法
sheet1.range("a1:b100").clearcontents

'删除行
Worksheets("Sheet1").Rows(3).Delete	'删除第三行

'插入行
Worksheets("Sheet1").Rows(3).Insert

'插入列
Columns("b").Insert
 
9. 自动调整列宽
 
Range("a1:h1").EntireColumn.AutoFit
 
10. 单元格范围与偏移使用
 
适用于单元格对象
 
'使用resize表示单元格范围
'如果只传入一个参数的话，表示以单元格为起点到向下第10个单元格的连续单元格区域。这里相当于range("a1:a10")
Range("a1").Resize(10).Value = 1
'传入两个参数，第一个以单元格为起点的区域单元格行数，第二个参数以单元格为起点的区域单元格列数
Range("b1").Resize(2, 3).Value = 2

'offset是偏移量，类似excel的offset函数，第一个参数上下（负正）偏移，第二个参数左右（负正）偏移，如果前面是一个单元格对象，参数是可以传入负数的。
Range("b4").Offset(2).Value = 3
Range("b4").Offset(2, 2).Value = 4
Range("b4:c5").Offset(3, 2).Value = 5
Range("c9").Offset(1, -1).Value = 6
 
使用效果图下图：
 
 
 
二、工作表-工作簿
 
1. 工作表&工作簿表示
 
1.1 工作表表示
 如下图片选中，工作表一共有三种表示。
 
 
使用工作表隐式名字：sheet3
使用工作表显示名字：sheets(“工作表显示名字”)，通常情况下，显示名字跟隐式名字是一样的，如果是一样的，也可以这么表示：sheets(“sheet3”)
使用索引：sheets(1) 根据工作表在excel中从左到右的位置，该工作表为第一个。
当然也可以使用活动工作表：activesheet，active跟单元格，工作簿等是一样适用的。
使用父对象：range("a1").parent
 1.2 工作簿表示 
  
这个工作簿：thisworkbook，写代码所在工作簿
活动工作簿：activeworkbook
使用索引：workbooks(1) 同工作表
使用工作簿名字：workbooks(“工作簿名字”)
使用父对象：range("a1").parent.parent
 
 
1.3 工作簿设置对象
 一般我们会为工作簿设置对象，方便引用，如果存在多个对象，这样就不会混乱。
 set wb = workbooks.open(“需要打开工作簿完整路径”)
 
2. 常用语句
 
2.1 工作表
 
2.1.1 新建工作表
 
ThisWorkbook.Sheets.Add Before:=Worksheets(1)
activesheet.name = "新建工作表命名"
 
或者可以直接这样：
 
Sheets.Add.Name = "新建工作表命名"
 
2.1.2. 取消筛选
 如果工作当前有筛选的话，取消筛选。
 
If Sheets("明细").AutoFilterMode = True Then Sheets("明细").AutoFilterMode = False
 
2.1.3. 工作表隐藏
 如果你不想某些工作表展示的话，可以这么操作，当visible参数为2时（深度隐藏），工作表鼠标右击操作是无法显示工作簿的； (-1：显示；0：隐藏；2：深度隐藏)
 
'深度隐藏sheet1工作表
sheet1.visible = -2
 
2.1.4. 删除工作表
 
sheet1.detete	删除工作表
 
2.1.5. 取消当前工作表所有的超链接
 
Cells.Hyperlinks.DeleteCells.Hyperlinks.Delete
 
2.1.6 工作表复制（复制到原工作簿或新工作簿）
 
Sub sheet_copy_to_new_workbook()
Dim new_wb As Workbook
Dim st
dim i as Byte
With ThisWorkbook
'复制工作表，如果没有指定after（位置）参数，就会自动创建一个新的工作簿,复制工作表到新创建的工作簿
    .Sheets(1).copy
    '设置新创建工作簿对象
    Set new_wb = ActiveWorkbook
    For i = 2 To .Sheets.Count
        .Sheets(i).copy new_wb
        '如果是下面这样写的话，是在原来工作簿上复制工作表，复制的工作表位置放在最后面。
        '.Sheets(i).copy after:=worksheets(sheets.count)
        .Sheets(i).copy after:=new_wb.Sheets(new_wb.Sheets.Count)
        '也可以给复制的工作表重新命名
        ActiveSheet.Name = i
    Next
End With
'保存新工作簿到指定路径，命名为“new_workbook.xlsx”
wb.SaveAs "d:/桌面/new_workbook.xlsx"
'这里其实是复制了当前工作簿(复制工作表示例)，如果不想做其他修改，比如修改表名等信息，也可以使用文件复制语法：FileCopy+Name实现文件复制及重命名
'语法如下：
FileCopy "f:\initial.xlsx", "e:\copy_file.xlsx"
Name "e:\copy_file.xlsx" As "e:\new_name.xlsx"
End Sub
 
2.2 工作簿
 
2.2.1 打开工作簿,并指定对象
 
set wb = workbooks.open("d:/Desktop/test.xlsm")		
'打开带密码的工作簿，password为工作簿密码
workbooks.Open Filename:="D:\桌面\代码储藏.xlsm", Password:="1234"
 
2.2.2 新建工作簿另存
 
Set wb = Workbooks.Add
'复制这个工作簿“通报”工作表的内容到新工作簿工作表
ThisWorkbook.Sheets("通报").[a1].CurrentRegion.Copy wb.Worksheets("Sheet1").[a1]
'工作簿另存为
wb.saveas "d:/Desktop/新工作簿名字.xlsx"
'关闭工作簿，并且保存,如果后面的参数为False，如果没有事先保存的话，则会丢失修改数据。
wb.close True
 
2.2.3 保存工作簿
 
thisworkbook.save
'或者也可以这样
thisworkbook.saved = true
 
2.2.4 工作簿的名字
 
thisworkbook.name
'工作簿带路径完整的名字
thisworkbook.fullname
 
2.2.5 删除工作簿
 
'kill + fullname,使用kill方法也可以删除其他文件，后面带完整路径。
kill "d:\Desktop\wb_delete.xlsx"