使用VBA从多个工作簿导出工作表 [英] Export a sheet from multiple workbooks using VBA

问题描述

VBA初学者在这里！



我有一个包含许多excel工作簿的文件夹。

将文件夹视为C：\ test，工作簿名为one.xlsx，two.xlsx，three.xlsx。

每个工作簿都有多个工作表。

我需要一个宏来保存所有工作簿中只有一张表作为新的Excel表格。



例如我需要将所有三个excel中的Demo表单保存为单独的表格。



请帮忙！

VBA beginner here !

I have a folder with many excel workbooks.
Consider folder as "C:\test" with workbooks named one.xlsx , two.xlsx , three.xlsx.
Each workbook has multiple sheets.
I need a macro to save only one sheet which is present in all workbooks to as a new excel sheet.

e.g I need to save "Demo" sheet present in all three excels as individual sheets.

Please help !

推荐答案

以下是一个示例：

Here is an example:

Option Explicit

Sub CopyDemoSheet()
Dim sPath As String, sFile As String
Dim dstWbk As Workbook, srcWbk As Workbook
Dim dstWsh As Worksheet, srcWsh As Worksheet

On Error GoTo Err_CopyDemoSheet

'create new workbook
Set dstWbk = Application.Workbooks.Add

'loop through the collection of Excel files
sPath = "C:\test\"
sFile = Dir(sPath)
Do While sFile <> ""
    'is this Excel file?
    If LCase(Right(sFile, 3)) <> "xls" Then GoTo SkipNext
    'open existing  Excel file
    Set srcWbk = Application.Workbooks.Open(sPath & "\" & sFile)
    'get source worksheet
    Set srcWsh = srcWbk.Worksheets("Demo")
    'copy source workshhet to destination file - at the end ;)
    srcWsh.Copy dstWbk.Worksheets(dstWbk.Worksheets.Count)
    'get destination worksheet
    Set dstWsh = dstWbk.Worksheets(dstWbk.Worksheets.Count)
    'you can proccess with destination Worksheet
    'for example, you can change the name of it
    'dstwsh.Name = "Whatever"
    
    'close
    srcWbk.Close SaveChanges:=False

'if it's not an Excel file
SkipNext:
    'get next file
    sFile = Dir()
Loop

'exit procedure
Exit_CopyDemoSheet:
    'ignore errors and clean up ;)
    On Error Resume Next
    'close destination file
    'dstWbk.Close SaveChanges:=True
    Set dstWbk = Nothing
    Set dstWsh = Nothing
    Set srcWbk = Nothing
    Set srcWsh = Nothing
    Exit Sub
    
Err_CopyDemoSheet:
    'display error message
    MsgBox Err.Description, vbExclamation, "Error no.:" & Err.Number
    'go to exit procedure
    Resume Exit_CopyDemoSheet
End Sub

请阅读所有评论。



注意：未经测试！

Please, read all comments.

Note: not tested!

这篇关于使用VBA从多个工作簿导出工作表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！