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

时间:2015-08-14 12:57:37

标签: excel vba excel-vba

我有这个代码从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

2 个答案:

答案 0 :(得分:1)

由于您的宏位于要引用的工作簿中,因此您只需使用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

答案 1 :(得分:0)

我会发布这个只是一个评论,但它不会让我。

我不确定我是否正在按照您的要求进行操作,但如果仅仅是自动保存具有不同名称的单独副本,那么它将是Workbooks(“FRF_Data_Sheet_Template.xlsm”)。 SaveCopyAs