Reputation: 29
I have this code and I am trying to get it to add a line in when copying the information accross. The issue I have is that it adds a line in between them and scrambles the information. I have a template worksheet with a total on the bottom and basicly want it pushed down as the lines are enetered.
Any help would be great
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
Upvotes: 0
Views: 1260
Reputation: 19737
Try this then:
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
Upvotes: 2