將多個選項卡複製到文件夾中的一個選項卡時出現excel VBA 1004錯誤

當我嘗試將工作簿頁面合併到一個主文檔中時，出現1004錯誤。代碼在我的設備上正常工作，但是當我嘗試在朋友設備上運行代碼時，它會引發1004錯誤。我相信他在Excel 2013中，我在Excel 2016中。有什麼方法可以將我的代碼轉換爲可以在兩種設備上使用的代碼？將多個選項卡複製到文件夾中的一個選項卡時出現excel VBA 1004錯誤

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文件中提取一個工作表並將它們合併爲一個主文檔的代碼。能夠挑選並選擇哪些工作表只是一種獎勵。

謝謝！

來源

2017-09-12 Michael

哪一行會引發異常？ – braX

不要'激活'窗口，不要使用隱式引用活動工作簿的不合格'Sheets'集合。如果您只打算使用「工作表」對象，請使用「工作表」集合而不是「表格」集合。改爲使用'wBk'工作簿對象引用。 'wkb.Worksheets（wSht）.Copy Before：= ThisWorkbook.Worksheets（1）'。調用'ThisWorkbook.Save'，而不是依賴關閉'wBk'後隱式重新激活它。 –

此外，您的代碼假定用戶輸入有效，並且不驗證任何內容。也許從輸入驗證開始吧？ –

像馬特杯子說，你應該真的驗證你的輸入。

您的同事在路徑的末尾添加了「\」嗎？路徑是否存在？

測試，以確保紙張您從複製的文件中存在，像這樣的東西：

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

來源

2017-09-12 20:55:02 Profex

將多個選項卡複製到文件夾中的一個選項卡時出現excel VBA 1004錯誤

回答

相關問題