生成多个格式相同sheet

李伟杰123

表一：工程信息

工程信息

表二：结算书封面



把工程信息表格里指定的内容【工程】【名称】【应付款】，复制到固定格式的封面，每行信息生成一个单独的sheet

gwjkkkkk

请参考附件。。。

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim ar, br, i&, j&, n&, wks As Worksheet
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    ar = [A1].CurrentRegion.Value
    br = [{"B2",2;"B3",3;"F2",4}]
    Set wks = Worksheets("结算书")
   
    With Workbooks.Add
        For i = 3 To UBound(ar)
            wks.Copy after:=.Worksheets(.Worksheets.Count)
            With ActiveSheet
                n = n + 1
                .Name = n
                For j = 1 To UBound(br)
                    .Range(br(j, 1)) = ar(i, br(j, 2))
                Next j
            End With
        Next i
        For Each wks In .Worksheets
            If wks.Name Like "*Sheet*" Then wks.Delete
        Next
    End With
      
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Beep
End Sub

wang-way

1. function distribute(){
   
2.         let wb=ThisWorkbook;
   
3.         let sht=wb.Worksheets.Item('分包合同、分包结算');
   
4.         let msht=wb.Worksheets.Item('结算书');
   
5.         let ar=sht.Range('A2').CurrentRegion.Value2;
   
6.         ar=ar.slice(1);
   
7.         ar.forEach((r,i)=>{
   
8.                 msht.Copy(Before=wb.Worksheets.Item(1))
   
9.                 let newsht=wb.Worksheets.Item(1);
   
10.                 newsht.Name=i;
    
11.                 newsht.Range("b2").Value2=r[1];
    
12.                 newsht.Range("b3").Value2=r[2];
    
13.                 newsht.Range("f2").Value2=r[3];
    
14.         })
    
15. }

复制代码