VBA將其他電子表格合併爲一個

感謝您閱讀我的問題。我試圖將很多文件導入到一個工作簿中。VBA將其他電子表格合併爲一個

此部分腳本在第一個工作簿中工作一次，但在第二個工作簿中碰到第三個工作簿時崩潰。

Do While Filename <> "" 
    Workbooks.Open Filename:=Path & Filename, ReadOnly:=True 
    Set tmpWb = ActiveWorkbook 

    For Each Sheet In tmpWb.Sheets 


     Range("A2").Select 
     If Range("A2").Value <> "" Then 
      sFileName = tmpWb.Name 
      sFileName = Replace(sFileName, ".xlsx", "") 
      Sheet.Name = sFileName 
      wbNew.Activate 
      Sheet.Copy After:=wbNew.Sheets(1) 
     Else 
      'do nothing 
     End If 
     tmpWb.Activate 

     On Error GoTo LastSheet 
      Worksheets(ActiveSheet.Index + 1).Select 
LastSheet: 

    Next Sheet 

    Workbooks(Filename).Close 
    Filename = dir() 

Loop

它的崩潰在工作表（ActiveSheet.Index + 1）。選擇與此錯誤 運行時錯誤9下標越界

來源

2016-07-07 Rick FlyFish

我猜這是因爲當你的活動工作表是最後的紙張，T如果沒有'ActiveSheet.Index + 1'來引用。 –

這裏有大量的錯誤。例如，你沒有明確地設置活動工作表的任何地方（只有活動工作簿），所以命令如「Range（」A2「）.Select」幾乎是一個廢話。 – RBarryYoung

範圍上的好點，我在第一個範圍（「A2」）之前添加了tmpWb.ActiveSheet以確保它被選中。 –

做，花了一點時間，算起來出但這功能很好，現在，也許還有另一種錯誤，但它可以被用於導入從文件的文件和圖紙到一個工作簿

Sub GetSheets() 
Dim sFileName As String 
Dim Path As String 
Dim wbNew As Workbook 
Dim tmpWb As Workbook 
Dim tSheets As Long 
Dim iSheets As Long 
    iSheets = 0 
    Set wbNew = gWrkBook() 'creat new workbook 

    Path = gGetFolder("Any default folder path") 
    If gSearch(Path, "\", "LastChar") > 0 Then 
     Path = Path + "\" 
    End If 
    Filename = dir(Path & "*.xlsx") 

    Do While Filename <> "" 
     Workbooks.Open Filename:=Path & Filename, ReadOnly:=True 
     Set tmpWb = ActiveWorkbook 
     tSheets = tmpWb.Worksheets.Count 

     If tSheets > 0 Then 
      iSheets = 1 
      tmpWb.Sheets(iSheets).Activate 

      For iSheets = 1 To tSheets 
       tmpWb.Sheets(iSheets).Activate 
       Range("A2").Select 

       If Range("A2").Value <> "" Then 
        sFileName = tmpWb.Name + "-" + CStr(iSheets) 
        sFileName = Replace(sFileName, ".xlsx", "") 
        tmpWb.Sheets(iSheets).Name = sFileName 
        wbNew.Activate 
        tmpWb.Sheets(iSheets).Copy After:=wbNew.Sheets(1) 

       Else 
       End If 
       tmpWb.Activate 
      Next 
     End If 

     Workbooks(Filename).Close savechanges:=False 
     Filename = dir() 

    Loop 
End Sub 

    Public Function gGetFolder(strPath As String) As String 

Dim fldr As FileDialog 

    Set fldr = Application.FileDialog(msoFileDialogFolderPicker) 

    With fldr 
     .Title = "Select a Folder" 
     .AllowMultiSelect = False 
     .InitialFileName = strPath 

     If .Show <> -1 Then GoTo NextCode 
      sItem = .SelectedItems(1) 
    End With 

NextCode: 
    gGetFolder = sItem 
    Set fldr = Nothing 

End Function

來源

2016-07-08 15:34:53

VBA將其他電子表格合併爲一個

回答

相關問題