Excel VBA宏，用于打开信息并将信息从一个工作簿加载到另一个工作簿

Question

各位下午好，

我一直致力于将一些excel宏从一个非常古老的宏设置更新为VBA宏。至于如何修复这些问题，我真的不确定我在寻找什么，因为我最近才开始学习VBA。我遇到的问题最多的一个是从指定工作簿中获取信息，将其插入当前工作簿，并且不覆盖公式。"HEAT5.XLSX"是将接收信息的主文件。原始宏是这样的：
`

Open (o)
=PROTECT.DOCUMENT(FALSE,FALSE,,FALSE)
=OPEN(!F1)
=PROTECT.DOCUMENT(FALSE,FALSE,,FALSE)
=WINDOW.TITLE(!F1)
=SELECT("R1C3:R37C4")
=COPY()
=ACTIVATE("HEAT5.XLSX")
=SELECT("R1C3")
=PASTE()
=ACTIVATE(!F1)
=SELECT("R2C6:r6c6")
=COPY()
=ACTIVATE("HEAT5.XLSX")
=SELECT("R2C6")
=PASTE()
=ACTIVATE(!F1)
=SELECT("R1C14")
=COPY()
=ACTIVATE("HEAT5.XLSX")
=SELECT("R2C14")
=PASTE()
=ACTIVATE(!F1)
=PROTECT.DOCUMENT(TRUE,FALSE,,TRUE)
=CLOSE(TRUE)
=ACTIVATE("HEAT5.XLSX")
=SELECT("R1C6")
=PROTECT.DOCUMENT(TRUE,FALSE,,TRUE)
=RETURN()`

到目前为止，我试图重现的是：

`Sub Retrieve()
Dim strFName As String
strFName = ThisWorkbook.Path & "" & Sheet1.Range("F1").Value & ".xlsx"
'this variable contains the workbook name and path
If FileExists(strFName) Then
'does it exist?
If Not BookOpen(Dir(strFName)) Then Workbooks.Open Filename:=strFName
'if its not already open, open it
Else
MsgBox "The file does not exist!"
End If
End Sub
Function FileExists(strfullname As String) As Boolean
FileExists = Dir(strfullname) <> ""
End Function
Function BookOpen(strWBName As String) As Boolean
Dim wbk As Workbook
On Error Resume Next
Set wbk = Workbooks(strWBName)
If Not wbk Is Nothing Then BookOpen = True
End Function`

如有任何建议和协助，我们将不胜感激。谢谢大家。

Answer 1

不确定你所说的"不覆盖公式"是什么意思，但为什么不试试这个而不是你得到的呢？你的看起来有点令人困惑。

Dim wbk as Workbook
Dim wbk2 as Workbook
Set wbk as Thisworkbook 'this one will be HEAT.xlsx
Set wbk2 as Workbooks.Open("FILENAME.xlsx")
wbk2.Activate    'makes FILENAME.xlsx your active workbook
Sheets("Sheet1").Range(Cells(1,3),Cells(37,4)).Select
Application.CutCopyMode = False
Selection.Copy
wbk.Activate
Sheets("Sheet1").Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wbk2.Activate
Sheets("Sheet1").Range(Cells(2,6),Cells(6,6).Select
Application.CutCopyMode = False
Selection.Copy
wbk.Activate
Sheets("Sheet1").Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

并在剩下的选择中重复此过程。细胞功能如下：

Cells(row number, column number)