在EXCEL表中，设置一个按钮，以实现一键点击后将表1中的相关数据复制到另一张表中...

maxjix

菜鸟深情求助~！

1.在“A4-列印”表中，我想在旁边设置一个按钮（导入），以实现一键点击后将表1中的相关数据，（对应的颜色部分）复制粘贴到“A4-列印”中对应的颜色部分区域。注：表1数据的行数不固定。

2.在“A4-列印”表中的序号列，可以根据复制过来的数据（行数），自动填入。

3.以上完成后，在最后一行自动汇总，同时最后一行的B到E列自动合并，并赋值“TOTAL";

4.在最后一行的下一行赋值：会计，审核和开票申请人（开票申请人自动从“表1”中的开票申请栏导入。

菜鸟很菜，拜托各位大神指点！感谢！

maxjix

Private Sub CommandButton2_Click()
          Dim HS As Integer
          HS = 6
          Do While Cells(HS, "A").Value <> ""    '判断表1中共有多上行
          HS = HS + 1
          Loop
          Dim XH As Integer                               '设置A4-列印中的序列号
          XH = 1
          Dim H As Integer
          For H = 6 To HS                                   '定义循环次数
                         Cells(H, "A").Value = XH         '给序列赋值
                         XH = XH + 1
                          Sheets("表1").Range(Cells(H, "J")).Select
'                          Range(Cells(H, "J")).Select
                          Selection.Copy
                          Sheets("A4-列印").Range(Cells(H, "B")).Select
'                          Range(Cells(H, "B")).Select
                          Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                              :=False, Transpose:=False
                              Application.CutCopyMode = False
                          Sheets("表1").Range(Cells(H, "E"), Cells(H, "G")).Select
'                          Range(Cells(H, "E"), Cells(H, "G")).Select

                          Selection.Copy
                          Sheets("A4-列印").Range(Cells(H, "C")).Select
'                          Range(Cells(H, "C")).Select
                          Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                              :=False, Transpose:=False
                              Application.CutCopyMode = False
                          Sheets("表1").Range(Cells(H, "K")).Select
'                          Range(Cells(H, "K")).Select
                          Application.CutCopyMode = False
                          Selection.Copy
                          Sheets("A4-列印").Range(Cells(H, "F")).Select
'                          Range(Cells(H, "f")).Select
                          ActiveSheet.Paste
                        
                          Next
                        Range(Cells(HS + 1, "A"), Cells(HS + 1, "E")).Select
                        With Selection
                            .HorizontalAlignment = xlCenter
                            .VerticalAlignment = xlCenter
                            .WrapText = False
                            .Orientation = 0
                            .AddIndent = False
                            .IndentLevel = 0
                            .ShrinkToFit = False
                            .ReadingOrder = xlContext
                            .MergeCells = False
                        End With
                        Selection.Merge
                        ActiveCell.FormulaR1C1 = "汇总"
                        Range(Cells(HS + 1, "F")).Select
                        ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
                       
                        Range(Cells(5, "A"), Cells(HS + 1, "F")).Select
                        Range(Cells(HS + 1, "F")).Activate
                        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                        With Selection.Borders(xlEdgeLeft)
                            .LineStyle = xlContinuous
                            .ColorIndex = 0
                            .TintAndShade = 0
                            .Weight = xlThin
                        End With
                        With Selection.Borders(xlEdgeTop)
                            .LineStyle = xlContinuous
                            .ColorIndex = 0
                            .TintAndShade = 0
                            .Weight = xlThin
                        End With
                        With Selection.Borders(xlEdgeBottom)
                            .LineStyle = xlContinuous
                            .ColorIndex = 0
                            .TintAndShade = 0
                            .Weight = xlThin
                        End With
                        With Selection.Borders(xlEdgeRight)
                            .LineStyle = xlContinuous
                            .ColorIndex = 0
                            .TintAndShade = 0
                            .Weight = xlThin
                        End With
                        With Selection.Borders(xlInsideVertical)
                            .LineStyle = xlContinuous
                            .ColorIndex = 0
                            .TintAndShade = 0
                            .Weight = xlThin
                        End With
                        With Selection.Borders(xlInsideHorizontal)
                            .LineStyle = xlContinuous
                            .ColorIndex = 0
                            .TintAndShade = 0
                            .Weight = xlThin
                        End With
End Sub

maxjix

谢谢，朱老师，您辛苦了！

terrencezy

制作完成的表格能发一下吗？