如何提取多个工作簿同一位置的数据

vba小白白+1

写了一段代码，运行的时候没有报错，运行后也提示“完成”，但没有抽取到任何数据，请各位大神帮忙看下这段代码哪里存在问题，感谢！
目的：成功抽取到工作簿里“主2增值税预缴表”表D10单元格的值。



Sub 按钮9_Click()
'//弹出窗口，让用户选择需要合并的工作簿
    MsgBox "请选择需要汇总的项目成本核对底稿"
    pth = Application.GetOpenFilename("文件(*.xls*),*.xls*", , "请选择文件", , True) 'GetOpenFilename支持通配符，true代表允许多选。
    If Not IsArray(pth) Then '如果用户没有选择文件，则返回False，不是数组。
        Exit Sub '退出过程
    End If
    '//
    Application.ScreenUpdating = False '禁止刷新，防止屏幕闪烁，提高运行速度
    Application.AskToUpdateLinks = False '禁止提示更新链接
    Application.DisplayAlerts = False '禁止无关的提示信息
    Set thissht = ThisWorkbook.ActiveSheet '把代码工作簿的活动工作表赋值给对象变量thissht
    For i = 1 To UBound(pth) 'GetOpenFilename多选文件的话返回的是一个数组，里面存放的是每个文件的路径，循环数组获取里面的文件路径。
        Set wb = Workbooks.Open(pth(i)) '将打开的工作簿赋值给对象变量wb
        Set sheeta = wb.Worksheets("主2增值税预缴表") '
        lastrow = thissht.Cells(thissht.Rows.Count, 1).End(3).Row + 1 '获取代码工作簿已使用的最大行号+1
        With thissht 'with结构，简化代码
            Cells(1, 1) = sheeta.Range("D10") '抽取工作表【主2增值税预缴表】的D10单元格
        End With
        wb.Close False '关闭打开的工作簿，直接用对象变量wb.clsoe即可。false表示不保存。
    Next
    Application.ScreenUpdating = True '开启刷新
    Application.AskToUpdateLinks = True '开启提示更新链接
    Application.DisplayAlerts = True '开启无关的提示信息
    MsgBox "完成！"
End Sub

杨建营

with thissht
.cells在这里少一个点
还有就是应该用一个区域保存你提取的数值，除非是只有一个数值。

With thissht
        .Cells(i, 1) = sheeta.Range("D10")
End With

vba小白白+1

杨建营 发表于 2023-2-6 07:15
with thissht
.cells在这里少一个点
还有就是应该用一个区域保存你提取的数值，除非是只有一个数值。

加上.之后就能取到数了。太感谢你啦~