求助大神解决

mx31876

ykcbf1100 发表于 2024-1-24 15:04
猜一下，可能还不是你想要的。

老师好，点了复制，生成了一个空白的文件，文件属性未知，命名也是不规则的。

mx31876

ykcbf1100 发表于 2024-1-24 15:04
猜一下，可能还不是你想要的。

老师好，我是需要将A文件的表，整张复制插入到C，B文件的表整张复制插入到C，如图片示例。

ykcbf1100

mx31876 发表于 2024-1-24 15:34
老师好，我是需要将A文件的表，整张复制插入到C，B文件的表整张复制插入到C，如图片示例。

改了，整表复制

gwjkkkkk

Option Explicit
Sub test()
    Dim br, i&, strFileName$, strPath$, strJoin$
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    strPath = ThisWorkbook.Path & "\"
    br = [{"A.xlsx","";"B.xlsx",""}]
    strJoin = "," & "A.xlsx" & "," & "B.xlsx" & ","
   
    For i = 1 To UBound(br)
        strFileName = Dir(strPath & br(i, 1))
        If strFileName = "" Then
             MsgBox br(i, 1) & "文件不存在，请检查！": Exit Sub
        End If
    Next i
    For i = 1 To UBound(br)
        With GetObject(strPath & br(i, 1))
            Set br(i, 2) = .Worksheets(1)
        End With
    Next i
    strFileName = Dir(strPath & "*.xls*")
    Do Until strFileName = ""
        If strFileName <> ThisWorkbook.Name Then
            If InStr(strJoin, "," & strFileName & ",") = False Then
                With Workbooks.Open(strPath & strFileName, 0)
                    If .Worksheets(1).Name <> "说明" Then br(1, 2).Copy before:=.Worksheets(1)
                    If .Worksheets(.Worksheets.Count).Name <> "内容" Then _
                        br(2, 2).Copy after:=.Worksheets(.Worksheets.Count)
                    .Close True
                End With
            End If
        End If
        strFileName = Dir
    Loop
    For i = 1 To UBound(br)
        Set br(i, 2) = Nothing
        Workbooks(br(i, 1)).Close False
    Next i
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Beep
End Sub

gwjkkkkk

请参考附件。。。

mx31876

gwjkkkkk 发表于 2024-1-24 19:58
Option Explicit
Sub test()
    Dim br, i&, strFileName$, strPath$, strJoin$

感谢大神，祝大神一生平安，健康。