工作表循环

hnycq77

我想把每个工作表都成小题分，总是第一个工作表能正常运行，第2个工作表就不能正常执行了。麻烦大咖帮我看看，问题出在哪儿？

hnycq77

#在这里快速回复#Sub 成绩条() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False Dim maxh, i, j, sht As Worksheet  For Each sht In Worksheets maxh = sht.Range("a1").CurrentRegion.Rows.Count  If Len(Trim(sht.Range("a" & maxh))) = 0 Then   sht.Rows(maxh).Delete   maxh = maxh - 1    End If     For i = maxh To 3 Step -1     sht.Rows(i).Insert     sht.Rows(1).Copy     sht.Rows(i).Select     sht.Paste     sht.Rows(i).Insert   Next i Next Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True MsgBox "完毕" End Sub

洋务德雷

程序要录制到模块中。这个用word里面的邮件合并就可以实现，为啥要在Excel中实现呢？

hnycq77

邮件合并也不能有多个数据源，这个问题困惑了很久，有什么好办法不？

hnycq77

洋务德雷 发表于 2023-5-14 22:38
程序要录制到模块中。这个用word里面的邮件合并就可以实现，为啥要在Excel中实现呢？

邮件合并也不能有多个数据源，这个问题困惑了很久，有什么好办法不？

gwjkkkkk

Option Explicit
Sub test()
    Dim ar, i&, Rng As Range
   
    With [A1].CurrentRegion
        ar = .Value
        .Offset(1).Clear
        Set Rng = .Rows(1)
        For i = 2 To UBound(ar) - 1
            If i <> 2 Then Rng.Copy .Cells((i - 2) * 3 + 1, 1)
            With .Cells((i - 2) * 3 + 2, 1).Resize(, UBound(ar, 2))
                .Value = Application.Index(ar, i)
                .Font.Size = 10
                .HorizontalAlignment = xlCenter
                .Borders.LineStyle = xlContinuous
            End With
        Next i
    End With
End Sub

gwjkkkkk

请参考附件。。。

cyq4896

四个表逐个运行

hnycq77

gwjkkkkk 发表于 2023-5-15 19:19
请参考附件。。。

谢谢！还是不能逐个循环，只能每个都要操作。不过7楼兄弟搞好！

hnycq77

cyq4896 发表于 2023-5-15 20:29
四个表逐个运行

太感谢你了！很好用！