哪位少侠帮出手一下，提取指定sheet表，具体要求见提取后文件中，

zk40

哪位少侠帮出手一下，提取指定sheet表，具体要求见提取后文件中，

明天会更好zj

问题都不会问，你是要让别人猜？你是要提取表过来，还是表里的数据，以什么样的方式显示你要得到的结果，你得自己模拟，而不是模棱两可的让别人猜测。

sj15627581616

是将几个工作表提取生成一个新的工作簿还是，每张表生成一个工作簿？

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.1.28
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set ws = ThisWorkbook
   
5.     Set sh = ws.Sheets("Sheet1")
   
6.     For Each sht In Sheets
   
7.         If sht.Name <> sh.Name Then sht.Delete
   
8.     Next
   
9.     p = ThisWorkbook.Path & ""
   
10.     f = p & "\汇总.xlsx"
    
11.     Set wb = Workbooks.Open(f, 0)
    
12.     fn = [{"张三","赵六","周八","吴九","郑十"}]
    
13.     For i = 1 To UBound(fn)
    
14.         Set sht = ws.Sheets.Add(after:=ws.Sheets(ws.Sheets.Count))
    
15.         sht.Name = fn(i)
    
16.         wb.Sheets(fn(i)).Cells.Copy sht.[a1]
    
17.     Next
    
18.     wb.Close 1
    
19.     sh.Activate
    
20.     Application.ScreenUpdating = True
    
21.     MsgBox "OK！"
    
22. End Sub
    

复制代码

ykcbf1100

附件供参考。。。

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim shts As Sheets
   
    Application.ScreenUpdating = False

    Set shts = Worksheets(Array("张三", "赵六", "周八", "吴九", "郑十"))
    shts.Copy
    With ActiveWorkbook
        .SaveAs ThisWorkbook.Path & "\生成表"
        .Close
    End With
   
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

参与一下。。。

yynrzwh

提取工作表.7z (31.59 KB, 下载次数: 7)

2024-1-28 13:39 上传

点击文件名下载附件

zk40

ykcbf1100 发表于 2024-1-28 11:56
参与一下。。。

谢谢老师， fn = [{"张三","赵六","周八","吴九","郑十"}]，实际中SHeet表很多，一行写不下，该如何换行

zk40

多谢各位老师的出手帮助