修改代码

ddz79101

老师！我想将本工作簿中指定的表复制到另工作簿中，修改代码（增加了条件）后，虽能导入其它工作簿中，但代码一直提示错误。请老师帮忙看看。谢谢

quqiyuan

Qs18

Sub 导出()
    Dim Items, strPath$, wkb As Workbook, sht As Worksheet
    strPath = ThisWorkbook.Path & "\"
    With Application.FileDialog(1)
        With .Filters
            .Clear
            .Add "Excel Files", "*.xls*"
        End With
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show Then Set Items = .SelectedItems Else Exit Sub
    End With
    Application.ScreenUpdating = False
    Set wkb = Workbooks.Open(Items(1), 0)
    With wkb
         For Each sht In ThisWorkbook.Sheets
             If sht.Name <> "目录" And sht.Name <> "理表" Then
                sht.Copy after:=.Sheets(.Sheets.Count)
            End If
        Next sht
        wkb.Close True
    End With
    Set wkb = Nothing
    Set sht = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

Qs18

测试一下................

ddz79101

quqiyuan 发表于 2024-6-22 13:18

老师！我这里有耶！请看

quqiyuan

ddz79101 发表于 2024-6-22 13:26
老师！我这里有耶！请看

你按照我叉掉的试试，主山掉，试试看，我也是注释后没有了

quqiyuan

ddz79101 发表于 2024-6-22 13:26
老师！我这里有耶！请看

注释后试试啊

gwjkkkkk

..............

ddz79101

gwjkkkkk 发表于 2024-6-22 15:25
..............

谢谢老师！运行成功

ykcbf1100

小改一下。