Copy multiple worksheets to one summary worksheet 1

[NRK]

I have a spreadsheet that has 10 worksheets (tabs). Seven of these sheets are data repositories that are updated manually. One worksheet will be a summary page that will have all information for these 7 sheets (sans header). As a note, the first two sheets grab certain summary information. Therefore, I need to specifically create code that search the abovementioned 7 sheets.

My difficulty is that while the number of columns is constant (9; A1:I1), the number of rows varies from sheet to sheet. In addition, as data is updated on these sheets, their lengths can vary. Thus, I need something dynamic that will grab all data in the range and stop when it encounters blank cells.

Here is how I imagine the flow of the code:
1. Activate sheet1(first data sheet)
2. Copy range of data in sheet1
3. Paste sheet1 range to summary sheet (starts at "A2&quot
4. Activate sheet2
5. Copy range of data in sheet2
6. Paste sheet2 range to summary sheet - will start below last entry from sheet1
7. Continue through sheet7

I have looked into a couple of options (namely creating an array and using UsedRange), but have been unsuccessful. Any advice/thoughts would be much appreciated.

Although there are similar requests, I have not found one that I was able to modify to my needs. If there is an applicable thread I missed, please let me know. Thank you, in advance.

 

[acron]

The folowing code will copy all data in sheets named from "Sh1" to "Sh7" ( Change as required ) to a sheet named "Summary". It is assumed the latter's first row is a header row.

Sub CreateSummary()
Dim oWS As Worksheet
Sheets("Summary&quot.Activate
For Each oWS In Sheets(Array("Sh1", "Sh2", "Sh3", "Sh4", "Sh5", "Sh6", "Sh7&quot)
oWS.Cells(1).CurrentRegion.Copy _
Destination:=[A65336].End(xlUp).Offset(1, 0)
Next
End Sub

Hope it at least gets you started.

A.C.

 

[NRK]

Fantastic! This is both simple and elegant in its functionality. Thank you very much.

If you feel like it, I do have a follow-up. After running the code, I noticed that I need to append the first row for each sheet (#1-7) and I need to ignore the first column (always A:A.

I believe that I can modify the Offset portion of the code to do this, but would like your feedback.

Again, thank you very much.

 

[acron]

Sorry for the late response.

To exclude Column A from being copied try replacing

oWS.Cells(1).CurrentRegion.Copy

with

Range([b1], [I1].Offset([b1].CurrentRegion.Rows.Count - 1, 0)).Copy.

I am not sure what you mean by

<, I noticed that I need to append the first row for each sheet (#1-7)>.

AC.

 

[NRK]

acron, thanks for the follow-up. Even with some slight modification, the code you submitted did not work for me.

Here is the code snippet:
Range([A2], [I2].Offset([A2].CurrentRegion.Rows.Count - 1, 0)).Copy Destination:=[A65336].End(xlUp).Offset(1, 0)

While it does ignore the first column, it only seems to copy the first row. So, I have 65,336 rows of the header repeated. I tried modifying your code, but was relatively unsuccessful. If you have any other insights, I would greatly appreciate it.

In regards, to my confusing second question, I am trying to copy a table of information that has a range of A1:Ixxx, where xxx is the length of the table, but ignore the first column (A) and ignore the first row 1.

As a simplistic example, if I have a range of A1:C4 - see data below - I only want to return the data in range B2:C4, where the x is. Note that h and c stand for Header and Column, respectively.

1 2 3 4
A h/c h h h
B c x x x
C c x x x

Let me know if this is sufficiently clear. Again, much thanks for your continued assistance.

 

[acron]

Sorry agin, but I should I have made it clear that the ranges should have been qualified with the sheet objec (oWS). Here is a revised version :

Sub CreateSummary()
Dim oWS As Worksheet
Sheets(&quot;Summary&quot.Activate
For Each oWS In Sheets(Array(&quot;Sh1&quot;, &quot;Sh2&quot)
Range(oWS.[B2], oWS.[B2].Offset(0, 7).End(xlDown)).Copy _
Destination:=[A65336].End(xlUp).Offset(1, 0)
Next
End Sub

Offset(0,7) in sets the columns from B to I, so you may need to change the 7.

Hope that works.

A.C.

 

[NRK]

In my efforts to continually tax your patience, I have a problem with the code.

When I run it, nothing is copied from the Array of sheets (Sh1, Sh2) to the Summary. In addition, I get alternating errors - 400 or Run-Time Error '1004'.

I tried copying your code verbatim, but still get the same errors. Worked on this for a while, but as you may have guessed, much of this is beyond my grasp in terms of diagnosing the problem.

From my understanding, it seems that your latest solution makes sense and should. That is why I am at a loss.

As always, your input is greatly appreciated. Hope you a good weekend, by the way.

 

[NRK]

Hadn't heard from Acron or any other Excel gurus lately. Thought I would check in to see if anyone had thoughts on how to address this problem.

I believe that I am very close to the solution, but can't seem to overcome this (hopefully) last obstacle.

Ben

 

[NRK]

In case anyone stumbles across this post and needs a solution, I wanted to post my final version.

It integrates my code with Acron's. Much thanks to Acron for his assistance.


Sub CreateSummary()
Dim oWS As Worksheet
Dim Rng As Range

Set Rng = Cells(Rows.Count, &quot;A&quot.End(xlUp)
Range(&quot;A3&quot;, Rng).EntireRow.Clear

For Each oWS In Sheets(Array(&quot;Sheet1&quot;, &quot;Sheet2&quot)
oWS.Range(&quot;B2:J65336&quot.Cells.SpecialCells(xlConstants).Copy _
Destination:=[A65336].End(xlUp).Offset(1, 0)
Next
End Sub