Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations John Tel on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Help with copying several excel worksheets to one sheet 2

Status
Not open for further replies.
bluegnu

bluegnu

Technical User
Sep 12, 2001
131
GB
Hello,

I've been using code that I've got from previous posts and from FAQ's. I'm trying to copy all the sheets in my workbook (with some exclusions), starting at row 15 and going to the end. I will then paste them to one single sheet at the bottom of the active selection.

So I thought I'd do this by first opening a form and loading a listbox of all the sheets I want. This pit works fine.

Then I'd cycle through the sheets and copy the active range from row 15 (this bit isn't working I don't think)

Then I'd paste it at the bottom of the active range in the chosen sheet (called Overall).

When I press my command button which triggers all this off I get an application-defined or object-defined error. This seems to be pointing to the copy code.

Code: 
Private Sub UserForm_Initialize()

'populate listbox with all sheets except exclusions
    Dim wbs As Worksheet
    
    For Each wbs In Worksheets
        If wbs.Name <> "Contents" Then
        If wbs.Name <> "Status" Then
        If wbs.Name <> "Introduction" Then
        If wbs.Name <> "Template" Then
        If wbs.Name <> "Overall" Then
            ListBox1.ColumnCount = 2
            ListBox1.AddItem wbs.Name
        End If
        End If
        End If
        End If
        End If
    Next

'copy sheets in listbox
 Dim i As Long
    For i = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(i) = False Then
    Dim LastRow As Long
    Dim FirstRow As Long
    Dim LastCol As Integer
    Dim FirstCol As Integer

    ' Find the FIRST real row
    FirstRow = Sheets(Me.ListBox1.List(i)).Cells.Find(What:="*", _
      SearchDirection:=xlNext, _
      SearchOrder:=xlByRows).Row

    ' Find the FIRST real column
    FirstRow = Sheets(Me.ListBox1.List(i)).Cells.Find(What:="*", _
      SearchDirection:=xlNext, _
      SearchOrder:=xlByRows).Column
    
    ' Find the LAST real row
    LastRow = Sheets(Me.ListBox1.List(i)).Cells.Find(What:="*", _
      SearchDirection:=xlPrevious, _
      SearchOrder:=xlByRows).Row

    ' Find the LAST real column
    LastCol = Sheets(Me.ListBox1.List(i)).Cells.Find(What:="*", _
      SearchDirection:=xlPrevious, _
      SearchOrder:=xlByColumns).Column
        
        'Select the ACTUAL Used Range as identified by the
       'variables identified above
Worksheets(Me.ListBox1.List(i)).Range(Cells(15, 1), _
    Cells(LastRow, LastCol)).Copy

'paste copied code to overall sheet    
'Dim laRow As Long
   ' Find the FIRST EMPTY row by adding 1 to the last row
    laRow = ActiveSheet.Cells.Find(What:="*", _
      SearchDirection:=xlPrevious, _
      SearchOrder:=xlByRows).Row + 1

    'Paste the data into the first
    'COMPLETELY empty row
    Sheets("Overall").Paste Destination:=Cells(laRow, 1)
      Application.DisplayAlerts = True
        End If
    Next i
    Unload Me
End Sub

Can anyone help me or point me in the right direction to get a different method to do this.

many thanks
 
Sort by date Sort by votes
can you paste the line where you have the break point

Chance,

Filmmaker, gentleman and Legal champion of the small people.
 
Upvote 0 Downvote
I haven't got a break point - should I?
 
Upvote 0 Downvote
I think Chance is asking what line was highlighted after the error.

[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ181-2886 before posting.
 
Upvote 0 Downvote
Oh I see, sorry for being a bit stupid.

I have a command button with the following code:

Code: 
Range("A15") = 1
    Dim LastRow As Long
    Dim FirstRow As Long
    Dim LastCol As Integer
    Dim FirstCol As Integer

    ' Find the FIRST real row
    FirstRow = ActiveSheet.Cells.Find(What:="*", _
      SearchDirection:=xlNext, _
      SearchOrder:=xlByRows).Row
      
    ' Find the FIRST real column
    FirstRow = ActiveSheet.Cells.Find(What:="*", _
      SearchDirection:=xlNext, _
      SearchOrder:=xlByRows).Column
    
    ' Find the LAST real row
    LastRow = ActiveSheet.Cells.Find(What:="*", _
      SearchDirection:=xlPrevious, _
      SearchOrder:=xlByRows).Row

    ' Find the LAST real column
    LastCol = ActiveSheet.Cells.Find(What:="*", _
      SearchDirection:=xlPrevious, _
      SearchOrder:=xlByColumns).Column
        
'Select the ACTUAL Used Range as identified by the
'variables identified above
ActiveSheet.Range(Cells(15, 1), _
    Cells(LastRow, LastCol)).Delete
    
UserForm3.Show

Userform3 will run the code in my initial post.

When the code breaks, the UserForm3.Show is highlighted.

However, if I comment out the "copy sheets in listbox" code in my original post, the userform runs correctly.

Does that make sense?

thanks
 
Upvote 0 Downvote
I don't supposed that helped did it?!
 
Upvote 0 Downvote
I think I have determined that the problem lies here:

Code: 
 Sheets(Me.ListBox1.List(i)).Range(Cells(15, 1), _
 Cells(LastRow, LastCol)).Copy"

Having jiggled it around a bit that's the bit that gets highlighted.

Any help is grately appreciated.
 
Upvote 0 Downvote
You may try to replace this:
Worksheets(Me.ListBox1.List(i)).Range(Cells(15, 1), _
Cells(LastRow, LastCol)).Copy
with this:
With Worksheets(Me.ListBox1.List(i))
.Range(.Cells(15, 1), .Cells(LastRow, LastCol)).Copy
End With

ie qualify the Cells properties.

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886
 
Upvote 0 Downvote
PHV hits an excellent point. Looking at your line...

Code: 
Worksheets(Me.ListBox1.List(i)).Range(Cells(15, 1), _
    Cells(LastRow, LastCol)).Copy

The only range referenced is the initial range (which doesn't even count because you're unioning two specific ranges inside the range object - which are not qualified/referenced. Without using a With/End With statement as PHV shows, you'd have to qualify like so ..

Code: 
Worksheets(Me.ListBox1.List(i)).Range(Worksheets(Me.ListBox1.List(i))Cells(15, 1), _
    Worksheets(Me.ListBox1.List(i))Cells(LastRow, LastCol)).Copy


Also, your command button code should be amended slightly, you have FirstRow being set twice and change the ActiveSheet to Me (if an ActiveX command button, the code goes into a worksheet module, therefore we have access to it's object model, so lets make use of it)...

Code: 
    Dim LastRow As Long, FirstRow As Long
    Dim LastCol As Long, FirstCol As Long

    Me.Range("A15") = 1

    ' Find the FIRST real row
    FirstRow = Me.Cells.Find(What:="*", _
                             after:=Me.Cells(Me.Rows.Count, Me.Columns.Count), _
                             SearchDirection:=xlNext, _
                             SearchOrder:=xlByRows).Row

    ' Find the FIRST real column
    FirstCol = Me.Cells.Find(What:="*", _
                             after:=Me.Cells(Me.Rows.Count, Me.Columns.Count), _
                             SearchDirection:=xlNext, _
                             SearchOrder:=xlByRows).Column

    ' Find the LAST real row
    LastRow = Me.Cells.Find(What:="*", _
                            after:=Me.Cells(1, 1), _
                            SearchDirection:=xlPrevious, _
                            SearchOrder:=xlByRows).Row

    ' Find the LAST real column
    LastCol = Me.Cells.Find(What:="*", _
                            after:=Me.Cells(1, 1), _
                            SearchDirection:=xlPrevious, _
                            SearchOrder:=xlByColumns).Column

    'Select the ACTUAL Used Range as identified by the
    'variables identified above
    Me.Range(Me.Cells(15, 1), Me.Cells(LastRow, LastCol)).Delete

HTH

Regards,
Zack Barresse

Simplicity is the ultimate sophistication. What is a MS MVP? PODA
- Leonardo da Vinci
 
Upvote 0 Downvote
Thanks guys, it's starting to make a bit more sense - thanks for the explanations. I'm still struggling a bit. It isn't liking this from the original code:

Code: 
Dim laRow As Long
   ' Find the FIRST EMPTY row by adding 1 to the last row
    laRow = ActiveSheet.Cells.Find(What:="*", _
      SearchDirection:=xlPrevious, _
      SearchOrder:=xlByRows).Row + 1

I get Object variable not set error message. I've tried changing Activesheet for the name of the sheet, which is more appropriate, worksheets("Overall") but that doesn't make a difference.

I'm just bit confused why this bit of code works in one instance but not in this instance!

thanks again.
 
Upvote 0 Downvote
If used in a worksheet module, use Me instead of ActivSheet. Try adding the After:= syntax.

Regards,
Zack Barresse

Simplicity is the ultimate sophistication. What is a MS MVP? PODA
- Leonardo da Vinci
 
Upvote 0 Downvote
Thanks for your response. I've now put this into a worksheet function:

Code: 
Private Sub Worksheet_Activate()

Dim LastRow As Long, FirstRow As Long
    Dim LastCol As Long, FirstCol As Long

    Me.Range("A15") = 1

    ' Find the FIRST real row
    FirstRow = Me.Cells.Find(What:="*", _
                             after:=Me.Cells(Me.Rows.Count, Me.Columns.Count), _
                             SearchDirection:=xlNext, _
                             SearchOrder:=xlByRows).Row

    ' Find the FIRST real column
    FirstCol = Me.Cells.Find(What:="*", _
                             after:=Me.Cells(Me.Rows.Count, Me.Columns.Count), _
                             SearchDirection:=xlNext, _
                             SearchOrder:=xlByRows).Column

    ' Find the LAST real row
    LastRow = Me.Cells.Find(What:="*", _
                            after:=Me.Cells(1, 1), _
                            SearchDirection:=xlPrevious, _
                            SearchOrder:=xlByRows).Row

    ' Find the LAST real column
    LastCol = Me.Cells.Find(What:="*", _
                            after:=Me.Cells(1, 1), _
                            SearchDirection:=xlPrevious, _
                            SearchOrder:=xlByColumns).Column

    'Select the ACTUAL Used Range as identified by the
    'variables identified above
    Me.Range(Me.Cells(15, 1), Me.Cells(LastRow, LastCol)).Delete


Dim i As Long
    For i = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(i) = False Then
        Me.ListBox1.Selected(i) = True
        End If
        Next i

       For i = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(i) = True Then
    Dim LastRow2 As Long
    Dim FirstRow2 As Long
    Dim LastCol2 As Integer
    Dim FirstCol2 As Integer

    ' Find the FIRST real row
    FirstRow2 = Sheets(Me.ListBox1.List(i)).Cells.Find(What:="*", _
      SearchDirection:=xlNext, _
      SearchOrder:=xlByRows).Row

    ' Find the FIRST real column
    FirstCol2 = Sheets(Me.ListBox1.List(i)).Cells.Find(What:="*", _
      SearchDirection:=xlNext, _
      SearchOrder:=xlByRows).Column
    
    ' Find the LAST real row
    LastRow2 = Sheets(Me.ListBox1.List(i)).Cells.Find(What:="*", _
      SearchDirection:=xlPrevious, _
      SearchOrder:=xlByRows).Row

    ' Find the LAST real column
    LastCol2 = Sheets(Me.ListBox1.List(i)).Cells.Find(What:="*", _
      SearchDirection:=xlPrevious, _
      SearchOrder:=xlByColumns).Column
        
        'Select the ACTUAL Used Range as identified by the
       'variables identified above
With Worksheets(Me.ListBox1.List(i))
  .Range(.Cells(16, 1), .Cells(LastRow2, LastCol2)).Copy
End With

    Dim laRow As Long
   ' Find the FIRST EMPTY row by adding 1 to the last row
    laRow = Sheets("overall").Cells.Find(What:="*", _
    SearchDirection:=xlPrevious, _
    SearchOrder:=xlByRows).Row + 1
    
    Application.DisplayAlerts = False
    
    'Paste the data into the first
    'COMPLETELY empty row
    Me.Paste Destination:=Cells(laRow, 1)
      Application.DisplayAlerts = True
        End If
    Next i
End Sub

and everything is working well except the

Code: 
    Dim laRow As Long
   ' Find the FIRST EMPTY row by adding 1 to the last row
    laRow = Sheets("overall").Cells.Find(What:="*", _
    SearchDirection:=xlPrevious, _
    SearchOrder:=xlByRows).Row + 1

I'm not sure what to do with this. It now works so that it copies each sheet in my listbox in the ranges specified. If I comment out the above, I can get it to paste all the sheet over each other. I just need to get each sheet pasted after each other but I'm not sure how.

Any further help you can give me with this is brilliant.

thanks
 
Upvote 0 Downvote
I have this working now. I think my workbook was corrupt, but this all works in a new workbook.

Thanks again for all your help.
 
Upvote 0 Downvote
I would still recommend you use the .After:= part of the Find syntax, else it will assume the activecell for that part.

Regards,
Zack Barresse

Simplicity is the ultimate sophistication. What is a MS MVP? PODA
- Leonardo da Vinci
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

K
  • Locked
  • Question
How to resolve define worksheets array
Replies
1
Views
762
combo
combo
remeng
  • Locked
  • Solved
Run-time error '429': ActiveX component can't create object From Excel to Word
Replies
9
Views
2K
remeng
remeng
arvarr
  • Locked
  • Question
Excel Help - Worksheets by UserID 3
2
Replies
39
Views
1K
arvarr
arvarr
remeng
  • Locked
  • Solved
Combine two working macros into one for MS Word 1
Replies
7
Views
1K
strongm
strongm
thanhthanh12
  • Locked
  • Question
Help vba
Replies
3
Views
665
combo
combo

Part and Inventory Search

Sponsor

Back
Top