VBA相关操作

sheet 另存为单个文件

Sub Test()
    Dim Sht As Worksheet
    For Each Sht In Sheets
        Sht.Copy
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Sht.Name & ".xlsx"
        ActiveWorkbook.Close
    Next
End Sub

sheet名字做超链接


Sub lianjie()
        Dim x As Long
                x = 0
                For x = 1 To Sheets.Count '从第四页开始
                        Sheet3.Hyperlinks.Add Anchor:=Cells(x, 4), Address:=ActiveWorkbook.Name,                         SubAddress:=Sheets(x).Name & "!A1", TextToDisplay:=Sheets(x).Name
                        '从sheet3的地14行第四列开始添加超链接,地址是当前当前工作薄的sheet(X)的名字,显示为sheet(X)的名字
 
                Next
End Sub

'功能:把多个excel工作簿的第一个sheet工作表合并到一个excel工作簿的多个sheet工作表,新工作表的名称等于原工作簿的名称
Sub Books2Sheets()    '定义对话框变量    
Dim fd As FileDialog    
Set fd = Application.FileDialog(msoFileDialogFilePicker)        '新建一个工作簿    
Dim newwb As Workbook    
Set newwb = Workbooks.Add        
With fd        
If .Show = -1 Then            '定义单个文件变量            
Dim vrtSelectedItem As Variant                        '定义循环变量            
Dim i As Integer            
i = 1                        '开始文件检索            
For Each vrtSelectedItem In .SelectedItems                '打开被合并工作簿                
Dim tempwb As Workbook                
Set tempwb = Workbooks.Open(vrtSelectedItem)                                '复制工作表                
tempwb.Worksheets(1).Copy Before:=newwb.Worksheets(i)                                '把新工作簿的工作表名字改成被复制工作簿文件名,这儿应用于xls文件,即Excel97-2003的文件,如果是Excel2007,需要改成xlsx                
newwb.Worksheets(i).Name = split(VBA.Replace(tempwb.Name, ".xlsx", ""),"-")(3)                                '关闭被合并工作簿                
tempwb.Close SaveChanges:=False                                
i = i + 1            
Next vrtSelectedItem        
End If    
End With        
Set fd = Nothing
End Sub

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值