Excel VBA - 打開工作簿並粘貼數據

-1

我發現了這個優秀的代碼，但我需要根據自己的目的調整它。Excel VBA - 打開工作簿並粘貼數據

首先，我需要打開我們網絡上的數據工作簿。我遇到的問題是有時可能會被其他用戶打開，並提供「只讀」選項。我怎樣才能讓它接受只讀選項，以便我可以開始提取數據。

其次它使用「=」進行復制。我怎樣才能改變它只複製值？

首先宏：

Sub test() 
'to open another workbook 
Application.ScreenUpdating = False 
Workbooks.Open Filename:=ThisWorkbook.Path & "\Schedule.xls" 
ThisWorkbook.Activate 
Application.ScreenUpdating = True 

End Sub

第二個宏：

Dim Sh As Worksheet 
Dim Newsh As Worksheet 
Dim myCell As Range 
Dim ColNum As Integer 
Dim RwNum As Long 
Dim Basebook As Workbook 

With Application 
    .Calculation = xlCalculationManual 
    .ScreenUpdating = False 
End With 

'Delete the sheet "Summary-Sheet" if it exist 
Application.DisplayAlerts = False 
On Error Resume Next 
ThisWorkbook.Worksheets("Summary-Sheet").Delete 
On Error GoTo 0 
Application.DisplayAlerts = True 

'Add a worksheet with the name "Summary-Sheet" 
Set Basebook = ThisWorkbook 
Set Newsh = Basebook.Worksheets.Add 
Newsh.Name = "Summary-Sheet" 

'The links to the first sheet will start in row 2 
RwNum = 1 

For Each Sh In Basebook.Worksheets 
    If Sh.Name <> Newsh.Name And Sh.Visible Then 
     ColNum = 1 
     RwNum = RwNum + 1 
     'Copy the sheet name in the A column 
     Newsh.Cells(RwNum, 1).Value = Sh.Name 

     For Each myCell In Sh.Range("A1,D5:E5,Z10") '<--Change the range 
      ColNum = ColNum + 1 
      Newsh.Cells(RwNum, ColNum).Formula = _ 
      "='" & Sh.Name & "'!" & myCell.Address(False, False) 
     Next myCell 

    End If 
Next Sh 

Newsh.UsedRange.Columns.AutoFit 

With Application 
    .Calculation = xlCalculationAutomatic 
    .ScreenUpdating = True 
End With 
End Sub

來源

2017-05-07 Angelo

你總是可以打開爲只讀，如果你只提取數據的工作簿。而不是使用.formula使用價值

來源

2017-05-07 19:26:09 supajason

謝謝賈森。請問您如何合併這兩個宏，以便打開數據工作簿以進行數據提取，然後不再保存任何更改。 – Angelo

Excel VBA - 打開工作簿並粘貼數據

回答

相關問題