Question

当我尝试将工作簿页面合并到一个主文档中时，我收到1004错误。代码在我的设备上正常工作，但是当我尝试在我的朋友设备上运行代码时，它会抛出1004错误。我相信他在excel 2013，我在excel 2016.有没有办法将我的代码转换成可以在两个设备上使用的东西？

Sub CombineSheets()
Dim sPath As String
Dim sFname As String
Dim wBk As Workbook
Dim wSht As Variant

Application.EnableEvents = False
Application.ScreenUpdating = False
sPath = InputBox("Enter a full path to workbooks")
ChDir sPath
sFname = InputBox("Enter a filename pattern")
sFname = Dir(sPath & "\" & sFname & ".xl*", vbNormal)
wSht = InputBox("Enter a worksheet name to copy")
Do Until sFname = ""
    Set wBk = Workbooks.Open(sFname)
    Windows(sFname).Activate
    Sheets(wSht).Copy Before:=ThisWorkbook.Sheets(1)
    wBk.Close False
    sFname = Dir()
Loop
ActiveWorkbook.Save
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

当我运行它时，它会正常工作，提示输入文件夹位置，询问它应该从哪个文件复制（通常是*），然后专门复制输入的工作表名称。

实际上我需要的是能够从几百个excel文件中提取一个工作表并将它们组合成一个主文档的代码。能够挑选哪些工作表只是奖金。

谢谢！

Answer 1

就像Mat的Mug所说，你应该真正验证你的输入。

您的同事是否在路径末尾添加了“\”？ Path甚至存在吗？

测试以确保工作表存在于您要复制的文件中，如下所示：

Function SheetExists(Name As String, Optional Workbook As Excel.Workbook = Nothing) As Boolean
If Workbook Is Nothing Then Set Workbook = ThisWorkbook.Application.ActiveWorkbook
On Error Resume Next
    If Workbook.Worksheets(Name).Name <> vbNullString Then
    End If
    If Err.Number = 0 Then SheetExists = True
On Error GoTo 0
End Function

以下是您的代码，其中包含所做的更改：

Sub CombineSheets()
Dim sPath As String
Dim sFname As String
Dim wBk As Workbook
Dim sSht As String

Application.EnableEvents = False
Application.ScreenUpdating = False
sPath = InputBox("Enter a full path to workbooks")
'Use the FolderPicker to verify the path
With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show Then sPath = .SelectedItems(1)
End With
'ChDir sPath
sFname = InputBox("Enter a filename pattern")
sFname = Dir(sPath & "\" & sFname & ".xl*", vbNormal)
sSht = InputBox("Enter a worksheet name to copy")
Do Until sFname = ""
    Set wBk = Workbooks.Open(sFname)
    'Windows(sFname).Activate
    If SheetExists(sSht, wBk) Then
        wBk.Sheets(sSht).Copy Before:=ThisWorkbook.Sheets(1)
    End If
    wBk.Close False
    sFname = Dir()
Loop
'ActiveWorkbook.Save
ThisWorkbook.Save
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

更大的问题是，Sheets的尺寸是否相同？旧.xls个文件只有65536行，其中2007 + .xlsx文件最多为1048576行。

您无法混合使用两种不同的工作表。在这种情况下，您需要将所有单元格从一个工作表复制到另一个工作表。

wBk.Sheets(sSht).Cells.Copy
ThisWorkbook.Sheets.Add Before:=ThisWorkbook.Sheets(1) 
ThisWorkbook.Sheets(1).Paste

将多个标签从文件夹

1 个答案: