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)