copy multiple sheets to same destination 3

[smurf01]

I have a work book that has 10 sheets in it and I want to copy the data from sheets 2 to 10 into sheet 1. the data from sheets 2 to 10 is all stored in the same cells (A3:Q200) and i want to copy each sheets data under each other.

i.e. sheet 1 will be in (A3:Q200), sheet 2 will be in (A201:Q400)etc. However my problem is that in sheet 2 the data may only be down to row 191 and then if this is the case i will have some empty rows

what I would like to know is how can I set a macro that pastes the data from sheet 1 then selects the next empty row down and then pastes sheet 2 and the selects the next empty cell down etc.

This is the code i have now

Sub CopySheet()

Sheets("1&quot.Select
Range("A3:Q200&quot.Select
Selection.Copy
Sheets("Summary&quot.Select
Range("A3&quot.Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Sheets("2&quot.Select
Range("A3:Q200&quot.Select
Selection.Copy
Sheets("Summary&quot.Select
Range("A201&quot.Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False


End Sub

Any Help would be much appreciated





Regards

Paul

 

[SkipVought]

      ws.Range("A3:Q200").Copy 
      wsSummary.Cells(.Row + .Rows.Count, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False

Glad I could help

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[smurf01]

Skip,Thanks again I suppose really I should have tried that myself i'm just not sure of the syntax sometimes. Could you suggest a good book on VBA that might help me whilst I am learning.

By the way thanks also for the help with thread707-686143. these two solutions will be of so much help to me.



Regards

Paul

 

[SkipVought]

Paul,

I like John Walkenbach's books. But alot of it depends on your style of learning and where you are in the learning process. I like a reference manual with some examples. Others like a how to type, like learn to program in VBA in 21 days.

A very powerful way to learn is to use the tools in the VB Editor. A way that I CONTINUE to learn, 'cuz what I know could fill a thimble compared to ALL that you could POSSIBLY do in VBA in just Excel, is to write some code in a sub, compile, open the Watch Window and then step into the code using the debug toolbar and ADD objects and properties, "OPEN" them up and observe all the "stuff" that is possible to work with. It's really handy with Objects like Charts and PivotTables and Ranges etc.

The Object Browser is also enlightening. And, of course, don't forget Help.

And last, but not least, Tek-Tips. I continue to learn and be challenged by the many great contributors!

Don't be shy ;-)

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[smurf01]

Skip,
Thanks for the info, i'll have a look on the "net" for some books and also try what you suggested

Regards

Paul

 

[smurf01]

Skip,
This is the code I ended up with after all of your help for performing what I needed however I have just found out one thing, if the sheet does not contain 200 rows of data then when I copy the last sheet I get blank rows at the end. As i am then linking this worksheet to Access as a table I then find that I have numerous empty rows in my access table.

Could you please tell me how to change the code so that it only picks up the used rows please.

Private Sub cmdCopyAll_Click()
    Range("A2:Q2").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=6
    Selection.ClearContents
    Range("A2").Select
Dim wsData As Worksheet
Set wsData = ActiveSheet
  For Each ws In Worksheets
    If ws.Name <> wsData.Name Then
      With wsData.[A3].CurrentRegion
      ws.Range(&quot;A3:Q300&quot;).Copy
      wsData.Cells(.Row + .Rows.Count, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
      End With
    End If
  Next
End Sub

Regards

Paul

 

[smurf01]

HI,

I tried to change my code by adding the lines in RED below but when I get to

 ws.Range(Cells(3, 1), Cells(LastCell, "Q")).Copy

I get a Run-time error '1004' application-defined or object-defined error.

Private Sub cmdCopyAll_Click()
    Range("A3:Q3").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=6
    Selection.ClearContents
    Range("A3").Select

Dim LastCell As Long

LastCell = Cells(Cells.Rows.Count, 1).End(xlUp).Row

Dim wsSummary As Worksheet
Set wsSummary = ActiveSheet
  For Each ws In Worksheets
    If ws.Name <> wsSummary.Name Then
      With wsSummary.[A2].CurrentRegion

ws.Range(Cells(3, 1), Cells(LastCell, "Q")).Copy

wsSummary.Cells(.Row + .Rows.Count, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
      End With
    End If
  Next
End Sub

Regards

Paul

 

[smurf01]

OK, So I have added the lines of code in RED to delete any used rows but, I am sure there is a better way, any help would be appreciated

Private Sub cmdCopyAll_Click()
    Range("A3:Q3").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=6
    Selection.ClearContents
    Range("A3").Select
Dim wsSummary As Worksheet
Set wsSummary = ActiveSheet
  For Each ws In Worksheets
    If ws.Name <> wsSummary.Name Then
      With wsSummary.[A2].CurrentRegion
      ws.Range(&quot;A3:Q300&quot;).Copy
      wsSummary.Cells(.Row + .Rows.Count, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
      End With
    End If
  Next

Range("A3").Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    Range("A3").Select
End Sub

Regards

Paul

 

[RobBroekhuis]

instead of

With wsSummary.[A2].CurrentRegion
ws.Range("A3:Q300&quot.Copy

you can do:

with ws.currentregion
ws.range(cells(3,1),cells(.row+.rows-1,17)).copy
end with
With wsSummary.[A2].CurrentRegion
...

Then you won't have to delete empty rows.


Rob

 

[smurf01]

Rob,
I have inserted the code that you suggested however when I get to the line

with ws.currentregion

I get an error message saying that
"objrct does not support this property or method", This is the code as I have it now

Private Sub cmdCopyAll_Click()
    Range("A2:Q2").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=6
    Selection.ClearContents
    Range("A3").Select
Dim wsSummary As Worksheet
Set wsSummary = ActiveSheet
  For Each ws In Worksheets
    If ws.Name <> wsSummary.Name Then
      With ws.CurrentRegion
        ws.Range(Cells(3, 1), Cells(.Row + .Rows - 1, 17)).Copy
        End With
        With wsSummary.[A2].CurrentRegion
      wsSummary.Cells(.Row + .Rows.Count, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
      End With
    End If
  Next
End Sub

Regards

Paul

 

[RobBroekhuis]

sorry, that should have been

With ws.[A3].CurrentRegion



Rob

 

[smurf01]

Rob,
sorry about this but i am now getting a type mismatch on the following line of code

ws.Range(Cells(3, 1), Cells(.Row + .Rows - 1, 17)).Copy

Regards

Paul

 

[SkipVought]

ws.Range(Cells(3, 1), Cells(.Row + .Rows.Count - 1, 17)).Copy

.Rows.Count



Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[smurf01]

Skip,
I know i am a pain but i am getting this error now

Run-time error '1004' application-defined or object-defined error.

Regards

Paul

 

[SkipVought]

are you working on a With rangeobject statement?

My guess NOT

The .Row & .Rows.Count need a RangeObject something like...

with ws.somerange
  ws.Range(Cells(3, 1), Cells(.Row + .Rows.Count - 1, 17)).Copy 
end with

where you're looking for the last row of that range using (.Row + .Rows.Count - 1



Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[smurf01]

Skip,
This is the code i am using, your goodself helped me with this at the start of the week and I thought I had checked it thoroughly however I found that the number of rows that I wanted to copy from each worksheet could vary and that by using "ws.Range("A3:Q300&quot.Copy" when i got to the last sheet I could have rows with no data in them.

But when I tried to link the sheet to access then the rows showed up as extra records. Therfore what i am trying to do is copy only the usedrange from each sheet without much success I hasten to add. I appreciate both you and Rob trying to help me out with this.

Private Sub cmdCopyAll_Click()
    Range("A2:Q2").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=6
    Selection.ClearContents
    Range("A3").Select
Dim wsSummary As Worksheet
Set wsSummary = ActiveSheet
  For Each ws In Worksheets
    If ws.Name <> wsSummary.Name Then
      With ws.[A3].CurrentRegion
        ws.Range(Cells(3, 1), Cells(.Row + .Rows.Count - 1, 17)).Copy
        End With
        With wsSummary.[A2].CurrentRegion
      wsSummary.Cells(.Row + .Rows.Count, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
      End With
    End If
  Next
End Sub

Regards

Paul

 

[SkipVought]

        Range(ws.Cells(3, 1), ws.Cells(.Row + .Rows.Count - 1, 17)).Copy

the worksheet object need to be applied to the cells object within the range definition.

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[smurf01]

Skip, Spot On Thank you very much. You will have to have a couple more medals in place of a star .

I have given Rob a star for putting me onto the right track

Regards

Paul