Vba Excel-打开指定名称的工作簿

我有下面的代码

非常简单，它要求用户选择多个excel工作簿，然后将这些工作簿中的数据复制并粘贴到当前工作簿中

一,。 我想添加功能，而不是用户选择excel工作簿。将选择excel工作簿，因为它们的名称列在当前excel工作表上

例如-在指定文件夹中选择excel工作簿，其名称列在A1:A5中

在将数据复制到当前工作手册之前，我希望对其执行自动处理

例如，如果工作簿名称=100.xlsx，则将所选内容乘以15

查看我的当前代码

Sub SUM_BalanceSheet()

Application.ScreenUpdating = False

'FileNames is array of file names, file is for loop, wb is for the open file within loop
'PasteSheet is the sheet where we'll paste all this information
'lastCol will find the last column of PasteSheet, where we want to paste our values
Dim FileNames
Dim file
Dim wb As Workbook
Dim PasteSheet As Worksheet
Dim lastCol As Long

Set PasteSheet = ActiveSheet
lastCol = PasteSheet.Cells(1, Columns.Count).End(xlToLeft).Column

'Build the array of FileNames to pull data from
FileNames = Application.GetOpenFilename(filefilter:="Excel Files (*.xlsx), *.xlsx", MultiSelect:=True)
'If user clicks cancel, exit sub rather than throw an error
If Not IsArray(FileNames) Then Exit Sub

'Loop through selected files, put file name in row 1, paste P18:P22 as values
'below each file's filename. Paste in successive columns
For Each file In FileNames
    Set wb = Workbooks.Open(file, UpdateLinks:=0)
    PasteSheet.Cells(1, lastCol + 1) = wb.Name
    wb.Sheets("Page 1").Range("L14:L98").Copy
    PasteSheet.Cells(2, lastCol + 1).PasteSpecial Paste:=xlPasteValues
    wb.Close SaveChanges:=False
    lastCol = lastCol + 1
Next

'If it was a blank sheet then data will start pasting in column B, and we don't
'want a blank column A, so delete it if it's blank
If Cells(1, 1) = "" Then Cells(1, 1).EntireColumn.Delete shift:=xlLeft

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

---

这是一个需要微调的帧，但您可以得到以下想法：

Dim i&, wbName$
Dim rng As Excel.Range
Dim wb, wb1 As Excel.Workbook

Set wb = Application.ThisWorkbook
Set rng = wb.Sheets("Sheet1").Range("A1")
For i = 0 To 14
    wbName = CStr(rng.Offset(i, 0).Value)
    On Error Resume Next 'Disable error handling. We will check whether wb is nothing later
    wb1 = Application.Workbooks.Open(wbName, False)
    On Error GoTo ErrorHandler
    If Not IsNothing(wb1) Then
        'Copy-paste here
        If wb1.Name = "100" Then 'any condition(s)
            'Multiply, divide, or whatever
        End If
    End If
Next


ErrorHandler:
    MsgBox "Error " & Err.Description
    'Add additional error handling

在没有绝对必要的情况下，尽量不要使用

ActiveSheet

和

ActiveWorkbook

。使用

ThisWorkbook

、专用

Workbook

对象和命名工作表

Workbook.Sheets（“名称”）

或

Workbook.Sheets（索引）

---

或者，您可以不禁用错误检查，而是在文件丢失时执行此操作并失败。

谢谢Eugene，我如何将范围扩大？@RalphDylan有多种方法，您可以迭代目标范围中的每个单元格，并分配新值

rng.value=rng.value*因子

，或者，您可以在工作表中的某个临时单元格中放入一个因子（

Set rngFactor=SomeSheet.Cells（1,1）.Value

），复制它，然后将其插入目标范围作为乘法值：

rngTarget.Paste特殊粘贴：=xlPasteValues，操作：=xlMultiply，skipblank:=False，转置：=False