合并范围中第一个单元格中可能没有数据的文件

Question

我有VBA代码正在运行。文件过去在A2中有某种数据(第1行是标题(。现在，如果A2为空，脚本将跳过该文件。

新版本的文件只有我在A2-AEC中需要的数据。我需要将位于文件夹中的所有文件合并到一个电子表格中(而不是多个选项卡(。

我试着找了几个消息来源，但没有找到任何有效的消息。

Sub GatherAndMerge()
Dim wb As Workbook
Dim r As Range
Dim s As String
Const FolderToSearch = "Z:...."  'adjust as desired
s = Dir(FolderToSearch, "*.xls?")
Do While s <> ""
If Right(FolderToSearch, 1) <> "" Then s = "" & s
Set wb = Workbooks.Open(FolderToSearch & s)
Set r = wb.Worksheets(1).UsedRange.Offset(1, 0)
r.Copy ThisWorkbook.Worksheets(1).Range("a" & Rows.Count).End(xlUp).offset1, 0
wb.Close False
s = Dir(0)
Loop
MsgBox "Done"
End Sub

当前代码。

Sub simpleXlsMerger()
Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")
'Set the save path here in the space below between the parentheses
'The Server is usually mapped to Z but should be verified
Set dirObj = mergeObj.Getfolder("Z:path-here")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)
'change "A2" with cell reference of start point for every files here
'for example "B3:IV" to merge all files start from columns B and rows 3
'the specified range is much more than the AMMS or Techs should ever send
Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate
'Do not change the following column. It's not the same column as above
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False
bookList.Close
Next
End Sub

Answer 1

Sub GatherAndMerge()
Dim wb as workbook
dim r as range
dim s as string
const FolderToSearch = "c:"  'adjust as desired
s = dir(foldertosearch*.xls?")
do while s <> ""
if right(foldertosearch,1)<> "" then  s = "" & s
set wb = workbooks.open(foldertosearch &  s)
set r = wb.worksheets(1).usedrange.offset(1,0)
r.copy thisworkbook.worksheets(1).range("a" & rows.count).end(xlup).offset(1,0) ' there was a missing bracket here
wb.close False
s = dir(0
loop
Msgbox "Done"
End Sub

写在我的手机上，没有excel，所以可能有打字错误