Allow append of data to a summary sheet in another workbook

Question

I have this code which appends data from three worksheets to a summary sheet, however on execution it is taking 12 of the 13 rows from sheet 1 and 2 and thirteen from sheet 3 to the summary I also would like this to work by sending to a summary sheet in a different workbook

Sub SummurizeSheets()
Dim ws As Worksheet

Application.ScreenUpdating = False
Sheets("Summary").Activate

For Each ws In Worksheets
    If ws.Name <> "Summary" Then
        ws.Range("D2:D6, D8:D15").Copy
        Worksheets("Summary").Cells(Rows.Count, 4).End(xlUp).Offset(0, 0).PasteSpecial (xlPasteValues)
    End If
Next ws
End Sub

You want the same exact thing to happen on a different workbook? I'm sure there are already a million references out there on how to reference a different workbook. Edit: Check out this: http://stackoverflow.com/questions/7401967/copy-data-from-another-workbook-through-vba/19317717#19317717 — Joe Laviano, Oct 22 '13 at 12:05

Joe · Answer 1 · 2013-10-22T12:44:47.503

Change Offset(0,0) to Offset(1,0). What's happening is not that it's copying 12 rows, but rather that the subsequent blocks are being pasted starting at the end of the previous block. That is, the first block is pasted into D1:D13, and the second block is pasted into D13:D26. By using Offset(1,0), the second block will be pasted starting with the first empty cell (that is, D14).

You can place the results in a new workbook simply by creating it in the code and referring to it in the paste, for example:

Option Explicit

Sub SummurizeSheets()
    Dim ws As Worksheet
    Dim currentWB As Workbook: Set currentWB = ActiveWorkbook
    Dim newWB As Workbook: Set newWB = Application.Workbooks.Add

    newWB.Worksheets(1).Name = "Summary"

    For Each ws In currentWB.Worksheets
        ws.Range("D2:D6, D8:D15").Copy
        With newWB.Worksheets("Summary").Cells(Rows.Count, 4).End(xlUp)
            If IsEmpty(.Value) Then
                .PasteSpecial (xlPasteValues)
            Else
                .Offset(1, 0).PasteSpecial (xlPasteValues)
            End If
        End With
    Next ws
End Sub

EDIT updated to paste into the first empty cell in column, even if that is row 1.

,That worked it now list all 13 but started in row 2 leaving a blank row how do I ammend that in the code many thanks — Steve, Oct 22 '13 at 12:15
Unfortunately, getting the "first empty cell in a column" isn't as easy as it should be. I'll update my answer. — Joe, Oct 22 '13 at 12:44

Allow append of data to a summary sheet in another workbook

1 Answers1