用macros将行添加到Excel中

我有这个代码，我试图让它在复制信息时添加一行。 我遇到的问题是它在它们之间增加了一条线，并对信息进行加扰。 我有一个总底部的模板工作表，基本上希望它下线，因为行。

任何帮助将是伟大的

Sub SummurizeSheets() Dim ws As Worksheet, wsSummary As Worksheet Dim c As Range Range("A4:D31").Select Selection.ClearContents Application.ScreenUpdating = False Set wsSummary = Sheets("Summary") ' Set destination cell Set c = wsSummary.Range("A4") For Each ws In Worksheets If ws.Name <> "Summary" Then ActiveCell.EntireRow.Insert ws.Range("D1").Copy c.PasteSpecial (xlPasteValues) ws.Range("E4").Copy c.Offset(0, 1).PasteSpecial (xlPasteValues) ws.Range("J39").Copy c.Offset(0, 2).PasteSpecial (xlPasteValues) ' Move destination cell one row down Set c = c.Offset(1, 0) End If Next ws Application.ScreenUpdating = True End Sub 

Answer 1

那么试试这个：

 Sub SummurizeSheets() Dim ws As Worksheet, wsSummary As Worksheet Dim c As Range Application.ScreenUpdating = False Set wsSummary = Sheets("Summary") Set c = wsSummary.Range("$A$4") For Each ws In Worksheets If ws.Name <> "Summary" Then c.EntireRow.Insert xlDown, xlFormatFromLeftOrAbove Set c = c.Offset(-1, 0) ws.Range("D1").Copy c.PasteSpecial xlPasteValues ws.Range("E4").Copy c.Offset(0, 1).PasteSpecial xlPasteValues ws.Range("J39").Copy c.Offset(0, 2).PasteSpecial xlPasteValues End If Next ws Application.ScreenUpdating = True End Sub