2016-05-24 1 views
0

Хорошие люди после обеда,Excel VBA макросов для открытия и загрузки информации из одной книги в другую

Я работал над обновлением некоторых первенствует макросов из очень старого стиля макро установки для макросов 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` 

Любые рекомендации и помощь будут очень признательны. Спасибо всем.

ответ

0

Не уверен, что вы подразумеваете под «не переопределяет формулы», но почему бы вам не попробовать это вместо того, что вы получили? Твоя выглядит немного запутанной.

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 работает следующим образом:

Cells(row number, column number) 
+0

Так я начал работать над этим, и я получил файл, чтобы открыть, и, похоже, что копирует из файла, но потом, когда он идет, чтобы вставить в основную книгу я получаю ошибка «Ошибка времени выполнения»: «Задержка вне диапазона» Проблема возникает в '' wbk.Activate ** Рабочие листы («Лист1»). Диапазон (ячейки (1, 3)). ** Selection.PasteSpecial Paste: = xlPasteValues, Operation: = xlNone, SkipBlanks _ : = False, Transpose: = False'' – Kemphler

+0

Часть кода с '** **' вокруг него - это проблема в момент, просто уточняющий. – Kemphler

+0

Извините, вы должны использовать вместо этого: Листы («Лист1»). Диапазон («C1»). Выберите – Mikey

Смежные вопросы