导出数据

ddz79101

老师！想将数据簿中的表格导入到汇总簿中对应表名中，有代码，但会删除其他表格且出错，请老师看看。谢谢

ddz79101

2个工作簿的表名一一对应，导出！

yanglinzi

yanglinzi

参与一下。。

ddz79101

yanglinzi 发表于 2024-10-30 16:31
参与一下。。

谢谢老师！运行成功！不过此代码与我的意思相反了，可能我的表述有问题，我想在导出数据簿中想数据到入到汇总簿中。因为实际工作中我想在《导出数据》簿中完成工作后顺手将数据导出。省的多个步骤和忘记。不知老师能否修改一下。谢谢

yanglinzi

ddz79101 发表于 2024-10-30 16:44
谢谢老师！运行成功！不过此代码与我的意思相反了，可能我的表述有问题，我想在导出数据簿中想数据到入到 ...

如果第二次导入时，不覆盖原有的数据，时这样吗？

ddz79101

yanglinzi 发表于 2024-10-30 17:17
如果第二次导入时，不覆盖原有的数据，时这样吗？

老师！就是在《导出数据》簿中操作，将《导出数据》中指定的四个表数据导出到《汇总》簿的对应同名表中。

ddz79101

ddz79101 发表于 2024-10-30 17:36
老师！就是在《导出数据》簿中操作，将《导出数据》中指定的四个表数据导出到《汇总》簿的对应同名表中。

老师！下次再导可以请空也可以覆盖

ddz79101

yanglinzi 发表于 2024-10-30 17:17
如果第二次导入时，不覆盖原有的数据，时这样吗？

谢谢你的提醒，我原表述有漏洞

gwjkkkkk

Sub test()
    Dim strFileName$, strPath$, wks As Worksheet, dic As Object, vKey
    Application.ScreenUpdating = False
    strPath = ThisWorkbook.Path & "\"
    strFileName = strPath & "导出数据.xls"
    If Dir(strFileName) = "" Then MsgBox "数据文件不存": Exit Sub
   
    Set dic = CreateObject("Scripting.Dictionary")
    With GetObject(strFileName)
        For Each wks In .Worksheets
            If isSheetExists(wks.Name) Then
                Worksheets(wks.Name).Cells.Clear
                wks.UsedRange.Copy Worksheets(wks.Name).[A1]
            End If
        Next
        .Close False
    End With
Application.ScreenUpdating = True
End Sub
Function isSheetExists(wksName$) As Boolean
    On Error Resume Next
    Set tempsheet = Worksheets(wksName)
    If Err.Number = 0 Then
        isSheetExists = True
    Else
        isSheetExists = False
    End If
End Function