如何使这个代码不依赖于文件名

我有这样的代码从4个单独的工作簿中提取数据，并将其粘贴到模板工作簿（FRF_Data_Macro_Insert_Test）中的下一个空白部分。 这工作完美，但我有一个问题，我需要它能够粘贴在活动工作簿，而不是依赖于文件名。 由于这是一个模板，因此只能读取，它会提示您在打开时另存为另一个文件名。 我告诉人们使用这个只是取消第一个保存为窗口，只是保存，因为当所有完成拉数据，但他们一直保存，因为之前，他们拉数据使它不工作，因为它寻找FRF_Data_Macro_Insert_Test文件名。 任何帮助深表感谢！ 谢谢

码：

Sub DataTransfer() Const FPATH As String = "C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\" Application.ScreenUpdating = False Dim wb As Workbook Dim shtAlpha As Worksheet 'Template Dim locs, loc Dim rngDest As Range locs = Array("Location1.xls", "Location2.xls", _ "Location3.xls", "Location4.xls") Set shtAlpha = Workbooks("FRF_Data_Sheet_Template.xlsm").Sheets("DataInput") 'set the first data block destination Set rngDest = shtAlpha.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Resize(5, 3) For Each loc In locs Set wb = Workbooks.Open(FileName:=FPATH & loc, ReadOnly:=True) rngDest.Value = wb.Sheets("Data").Range("I3:K7").Value wb.Close False Set rngDest = rngDest.Offset(0, 3) 'move over to the right 3 cols Next loc Application.ScreenUpdating = True End Sub 

Answer 1

由于您的macros在您要参考的工作簿中，因此您可以简单地使用ThisWorkbook：

 Sub DataTransfer() Const FPATH As String = "C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\" Application.ScreenUpdating = False Dim wb As Workbook Dim shtAlpha As Worksheet 'Template Dim locs, loc Dim rngDest As Range locs = Array("Location1.xls", "Location2.xls", _ "Location3.xls", "Location4.xls") Set shtAlpha = ThisWorkbook.Sheets("DataInput") 'set the first data block destination Set rngDest = shtAlpha.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Resize(5, 3) For Each loc In locs Set wb = Workbooks.Open(Filename:=FPATH & loc, ReadOnly:=True) rngDest.Value = wb.Sheets("Data").Range("I3:K7").Value wb.Close False Set rngDest = rngDest.Offset(0, 3) 'move over to the right 3 cols Next loc Application.ScreenUpdating = True End Sub 

Answer 2

我会张贴这只是一个评论，但它不会让我。

我不知道我是否遵循你所要求的正确的，但如果它是一个自动保存一个不同名称的单独副本的问题，那么它将是工作簿（“FRF_Data_Sheet_Template.xlsm”）。SaveCopyAs