Question

我想将整个工作表复制到另一个（特定的工作表）工作簿。源工作表采用.xlsb格式。非常感谢你提前

Answer 1

好的，我已经修改了我的答案，使其尽可能动态。您在下面看到的第一部分代码实现了以下目标：

浏览需要将源表格复制到
的文件

这将在整个目录中搜索文件

'UDF for finding a file no matter where it is located, providing it is within the HostFolders minimum location criteria
'The first function checks if the scripting runtime reference is enabled on hosts computer, and if not, enables it so that the FileSytemObject may be created
'The second function will find a specified file by begining with the intial stated HostFolder, and then go through all subfolders until it has found the file


Option Explicit
Dim FileSystem As Object
Dim HostFolder As String
Dim Ref As Object, CheckRefEnabled%

Sub FindFile()

HostFolder = "Insert folder path here\" 'Change this HostFolder to suit preference

CheckRefEnabled = 0
With ThisWorkbook
    For Each Ref In .VBProject.References
        If Ref.Name = "Scripting" Then
            CheckRefEnabled = 1
            Exit For
        End If
    Next Ref
    If CheckRefEnabled = 0 Then
        .VBProject.References.AddFromFile ("C:\Windows\System32\scrrun.dll")
    End If
End With

Set FileSystem = CreateObject("Scripting.FileSystemObject")
DoFolder FileSystem.GetFolder(HostFolder)

End Sub

Sub DoFolder(Folder)

Dim SubFolder
For Each SubFolder In Folder.SubFolders
    DoFolder SubFolder
Next

Dim File
For Each File In Folder.Files
    If File.Name = "insert name of file here.xlsb" Then
        Workbooks.Open (Folder.Path & "\" & File.Name), UpdateLinks:=False
        Workbooks(File.Name).Activate
        Exit Sub
    End If
Next

End Sub

代码的下一部分实现了以下目标：

将ThisWorkbook中的工作表复制到新打开的工作簿，保存并关闭它

Option Explicit
Dim w As Workbook

Sub sheetCopy()

Set w = ThisWorkbook

'amend this to suit your workbook names and sheet names
w.Sheets("Sheet1").Copy after:=Workbooks("workbook name").Sheets(1)

End Sub

所以，最后运行下面的完整代码以完成所有内容：

Option Explicit
Dim w As Workbook

Sub sheetCopy()

Set w = ThisWorkbook
FindFile

'amend this to suit your workbook names and sheet names
w.Sheets("Sheet1").Copy after:=Workbooks("workbook name").Sheets(1)

End Sub

尝试将xlsb工作表复制到另一个工作表

1 个答案: