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)