CODEWITHSUNDEEP
vbaexcel
Aussiehelper
Aussiehelper

Reputation: 29

Adding line into Excel with macro

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

Answers (1)

L42
L42

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

Related Questions