Question

VBA引用另一个工作薄的数据

求大神帮忙。

把工作薄的L列的数据引用到另一个带VBA工作簿的O列。
以下是现在用的VBA，只要把工作簿放到与带VBA工作簿的同一个文件夹，就可以把数据导入，
求大神帮忙修改一下。
Sub Macro1()
Dim mypath$, wj$, arr, brr, i&, s&, j% '变量声明 $为文本型，&为整数型

mypath = ThisWorkbook.Path & "\" '把文件路径定义给变量 '显示文本所在位置 目录下的名称

wj = Dir(mypath & "*.xls") '依次找寻指定路径中的*.xls文件
ReDim brr(1 To 20000, 1 To 100)
Application.ScreenUpdating = False '关闭屏幕刷新，以防屏幕抖动
Cells.NumberFormatLocal = "@"
Do While wj <> "" '当指定路径中有文件时进行循环 '循环条件当wj不等于空白单元格
If wj <> ThisWorkbook.Name Then '返回当前工作表名称
With GetObject(mypath & wj)
gzb = .Name
arr = .Sheets(1).UsedRange
If lie < UBound(arr, 2) Then lie = UBound(arr, 2)
For i = 9 To UBound(arr)
If arr(i, 1) = "序号" Or IsNumeric(arr(i, 1)) Then
s = s + 1
brr(s, 1) = gzb
brr(s, 2) = arr(3, 12)
brr(s, 3) = arr(3, 4)
For j = 1 To UBound(arr, 2)
brr(s, j + 3) = arr(i, j)
Next
End If
Next
.Close 0
End With
End If
wj = Dir
Loop
Range("a2").Resize(s, lie) = brr
Columns.AutoFit
Application.ScreenUpdating = True
End Sub





Answer 1

代码更改如下，试一下：

Dim mypath$, wj$  '变量声明 $为文本型，&为整数型
mypath = ThisWorkbook.Path & "\"           '把文件路径定义给变量 '显示文本所在位置 目录下的名称
wj = Dir(mypath & "*.xls")                 '依次找寻指定路径中的*.xls文件
Application.ScreenUpdating = False         '关闭屏幕刷新，以防屏幕抖动
Do While wj <> ""                          '当指定路径中有文件时进行循环 '循环条件当wj不等于空白单元格
    If wj <> ThisWorkbook.Name Then        '返回当前工作表名称
        With GetObject(mypath & wj)
            ThisWorkbook.ActiveSheet.Range("L3").Resize(ThisWorkbook.ActiveSheet.Cells(Rows.Count, "L").End(xlUp).Row - 2).Copy .ActiveSheet.Range("O1")
            .Close 0
        End With
    End If
    wj = Dir
Loop
Application.ScreenUpdating = True
End Sub

追问

你把我的代码缩短了这么多，肯定不行啦

追答

你只是复制一列数据到另一个工作簿，这就足够了。