分别复制工作表到两个工作簿

pfhbj

通过VBA，把“我的表”工作簿中“AAA”工作表和“BBB”工作表分别对应复制到“你的表”工作簿sheet1和“他的表”工作簿sheet1.

LIUZHU

复制的效果

LIUZHU

JSA代码

1. function 复制(){
   
2.         [["AAA","你的表"],["BBB","他的表"]].forEach(([a,b])=>{
   
3.                 Workbooks.Open(`${ThisWorkbook.Path}\\${b}.xlsx`);
   
4.                 ThisWorkbook.Sheets.Item(a).UsedRange.Copy(Range("a1"));
   
5.                 ActiveWorkbook.Close(true);
   
6.         });
   
7.         alert("复制完毕。");
   
8. }

复制代码

LIUZHU

整套附件，请审核

pfhbj

LIUZHU 发表于 2024-5-24 23:36
整套附件，请审核

整套附件里没有代码

pfhbj

有没有vba代码

LIUZHU

pfhbj 发表于 2024-5-25 11:38
有没有vba代码

Jsa，wps打开测试，JS宏

gwjkkkkk

Option Explicit
Sub test()
    Dim ar(), i&, strFileName$, strPath$
   
    strPath = ThisWorkbook.Path & "\"
    ReDim ar(1 To 2, 1 To 2)
   
    ar(1, 1) = strPath & "你的表.xlsx"
    If Dir(ar(1, 1)) = "" Then Exit Sub
   
    ar(2, 1) = strPath & "他的表.xlsx"
    If Dir(ar(2, 1)) = "" Then Exit Sub
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For i = 1 To 2
        Set ar(i, 2) = Sheets(i).[A1].CurrentRegion
        With Workbooks.Open(ar(i, 1), 0)
            With .Worksheets(1)
                .Cells.Clear
                ar(i, 2).Copy .[A1]
            End With
            .Close True
        End With
    Next i

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Beep
End Sub

gwjkkkkk

pfhbj 发表于 2024-5-25 11:38
有没有vba代码

..........

ykcbf1100

附件供参考。。。