修改VBA工作簿合并代码以解决列空白时的失败问题

我有一些小问题修改下面的代码：

Sub combine() LastCol = "G" Folder = GetFolder() fileSaveName = Application.GetSaveAsFilename( _ Title:="Get SAVEAS Filename", _ filefilter:="Excel Files (*.xls*), *.xls*") If fileSaveName = False Then MsgBox ("Cannot Save file - exiting Macro") Exit Sub End If Set newbk = Workbooks.Add Set NewSht = newbk.Sheets(1) With NewSht .Cells.ClearContents Folder = Folder & "\" FName = Dir(Folder & "*.xls*") Do While FName <> "" Set bk = Workbooks.Open(Filename:=Folder & FName) 

---

  For Each sht In bk.Sheets ThisbookLastRow = .Range("A" & Rows.Count).End(xlUp).Row If ThisbookLastRow = 1 Then NewRow = 1 'copy header row sht.Range("A1:" & LastCol & "1").Copy _ Destination:=.Range("B1") 'put filename in cell A1 sht.Range("A1") = "Workbook" End If NewRow = ThisbookLastRow + 1 With sht LastRow = .Range("A" & Rows.Count).End(xlUp).Row DataRows = LastRow - 1 Set CopyRange = .Range("A2:" & LastCol & LastRow) End With 'copy data from old workbook to this workbook If DataRows > 0 Then CopyRange.Copy _ Destination:=.Range("B" & NewRow) 'put book name into column A .Range("A" & NewRow & ":A" & (NewRow + DataRows - 1)) = _ FName End If Next sht bk.Close savechanges:=False FName = Dir() Loop 

---

  'put totals in last row LastRow = .Range("A" & Rows.Count).End(xlUp).Row NewRow = LastRow + 1 .Range("A" & NewRow) = "Total" LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column For Colcount = 4 To LastCol Set SumRange = .Range(.Cells(2, Colcount), _ .Cells(LastRow, Colcount)) .Cells(NewRow, Colcount).Formula = _ "=sum(" & SumRange.Address & ")" Next Colcount End With newbk.SaveAs Filename:=fileSaveName End Sub Function GetFolder() 'Declare a variable as a FileDialog object. Dim fd As FileDialog 'Create a FileDialog object as a Folder Picker dialog box. Set fd = Application.FileDialog(msoFileDialogFolderPicker) fd.Title = "Select Excel Workbook(s) Folder" 'Declare a variable to contain the path 'of each selected item. Even though the path is a String, 'the variable must be a Variant because For Each...Next 'routines only work with Variants and Objects. Dim vrtSelectedItem As Variant 'Use a With...End With block to reference the FolderDialog object. With fd 'Use the Show method to display the File Picker dialog box and return the user's action. 'The user pressed the action button. If .Show = -1 Then 'Step through each string in the FileDialogSelectedItems collection. For Each vrtSelectedItem In .SelectedItems 'vrtSelectedItem is a String that contains the path of each selected item. 'You can use any file I/O functions that you want to work with this path. 'This example simply displays the path in a message box. GetFolder = vrtSelectedItem Next vrtSelectedItem 'The user pressed Cancel. Else End If End With 'Set the object variable to Nothing. Set fd = Nothing End Function 

有效的代码是从Excel文件的选定文件夹中创build主书籍。 这很好，但是我的文件夹中的每个Excel工作簿都有大约30列，每个文件只有7个正在传输。 我怀疑这是因为第8列，虽然它有一个标题，但没有任何数据（它实际上是一个空白列）。 我怀疑上面的macros无法识别这个，并随后停止，当它击中该列并移动到下一个文件。 有没有办法改变代码，以防止这种情况发生？ 我不确定分区域或代码中的其他地方会发生什么变化。

Answer 1

最简单的改变不是一个重要的改写，就是把第二行改成：

LastCol =“AD”

那将复制三十列而不是七个。