2017-03-03 31 views
0

我在网站上找到了下面的VBA代码。它实质上是查看excel电子表格的文件夹并将它们合并为一个。它只会复制保存和关闭前最后打开的选项卡中的信息。如何将我的VBA代码更改为仅从具有特定名称的工作表中拉出?

如何更改此代码,使其仅从名为“模板”的选项卡进行复制?

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") 

'change folder path of excel files here 
Set dirObj = mergeObj.Getfolder("D:\change\to\excel\files\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 
'If you're files using more than IV column, change it to the latest column 
'Also change "A" column on "A65536" to the same column as start point 
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 

回答

1
For Each everyObj In filesObj 
    Set bookList = Workbooks.Open(everyObj) 
    Worksheets("Template").Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy ThisWorkbook.Worksheets(1).Range("A65536").End(xlUp).Offset(1, 0) 
    bookList.Close 
Next 

或者

For Each everyObj In filesObj 
    With Workbooks.Open(everyObj).Worksheets("Template") 
     .Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy ThisWorkbook.Worksheets(1).Range("A65536").End(xlUp).Offset(1, 0) 
     .Close 
    End With 
Next 
+0

太谢谢你了! –

+0

您好,欢迎光临 – user3598756

相关问题