Sub copygrid() '复制表格
Dim i&, t&
t = ActiveSheet.[a65536].End(xlUp).Row
For i = 1 To t
If ActiveSheet.Range("b" & i).MergeCells = True And ActiveSheet.Range("a" & i) <> "" Then
Sheets(6).Range("I2:S21").Copy ActiveSheet.Range("i" & i)
End If
Next
End Sub
==============================================================================
Sub copygrid1() '复制表格包括列宽Application.DisplayAlerts = False
Dim i&, t&
t = ActiveSheet.[a65536].End(xlUp).Row
For i = 1 To t
If ActiveSheet.Range("b" & i).MergeCells = True And ActiveSheet.Range("a" & i) <> "" Then
Sheets(6).Range("I2:S21").Copy
With ActiveSheet.Range("i" & i)
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteAll
End With
End If
Next
Application.CutCopyMode = False
Application.DisplayAlerts = True
End Sub