Code Help

[Philcjr]

I am really close to having this code work but I am stuck. From previous post, I am trying to copy data from one file and pasting it to another. I am pasting my code in the hopes that someone can point out my error(s). I put comments in the code to help, and also cited where the code breaks

any questions, please ask...

Option Explicit

Sub Get_Data()
Dim wk As Worksheet
Dim vlist
ChDir "C:\Documents and Settings\collinp\Desktop"
Application.EnableEvents = False
Workbooks.Open Filename:= _
    "C:\Documents and Settings\collinp\Desktop\GA_Spreadsheet_07-19-05.xls"
'unhides all sheet tabs
For Each wk In Worksheets
    wk.Visible = True
Next
' names of the sheet tabs
vlist = Array("Gloria Goodrich", "Kia Kelley", "Jeff Shonk", _
                "Laura DiFrancesco", "Rick Gribbin", "Other")
'code blows up in here right before the "End If"
For x = 0 To UBound(vlist)
    With Worksheets(vlist(x))
        If Not IsEmpty(.Range("A2")) Then
            .Range(.Range("A65536").End(xlUp), .Range("L2")).Copy _
            Workbooks("Book1").Worksheets(Sheet1).Range("A65536").End(xlUp).Offset(1, 0)
        End If
    End With
Next
Range("A2").Select
Columns("A:L").AutoFit
Selection.Sort Key1:=Range("E2"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Application.EnableEvents = True
ActiveWorkbook.Close
End Sub

[Norie]

How does it blow up?

[Philcjr]

The file opens, all sheet tabs unhide, I think the data from one sheet tabe is copied... then the error occurs.

Run-time error '9': Subscript out of range

I think it has to do with the istructions I give to paste in the new file "Workbooks("Book1").Worksheets(Sheet1)....

[Zack Barresse]

Add quotes to the sheet name...

Workbooks("Book1").Worksheets("Sheet1")...

[uvba]btw..[/uvba] I edited your post to use them, hope you don't mind.

[Philcjr]

firefytr,

Thanks for the tip on the VBA - /VBA... glad you did that.
I added the quotes... still the code breaks/blows up.

When the macro is executed the file opens, all sheet tabs are visible. However, the file that is opened is the active workbook, and I think when the code tries to paste the data into "Book1" - this file is not active. Does this help?

[Zack Barresse]

Hmm, do you even have an open workbook that is titled "Book1.xls"?

[Philcjr]

Yes, "Book1" is open and it contains the Maco that I have posted.
It opens the other file "GA_Spreadsheet_07-19-05.xls".
I am trying to copy the sheets in GA_Spreadsheet_07-19-05.xls and past all the data onto one sheet in "Book1"

[Zack Barresse]

Can you zip/upload a sample file?

What does this look like in your Watch Window: "Worksheets(vlist(x)).Range("A65536").End(xlUp)"??

[Philcjr]

Firefytr,

I would be more than happy to send you whatever you need.

Do you want to see "Book1" - my test file
Do you want to see "GA_Spreadsheet_07-19-05.xls"
or both?

If you want to see both, may I e-mail you directly, as there is somewhat of sensitive data... I work for a pharmaceutical company and there is live data. Later, I would post the corrected code for eveyones benefit.

If you object to direct e-mail, I will go in and try to filter out the data.

Just let me know

[johnske]

Hi Philcjr,

With respect to your adding the quotation marks to sheet1 as Zack suggested... Do you also have a worksheet named (on the sheet tab) Sheet1? (if not you'll get an out-of-range error) - or - are you trying to access the sheet with the code-name Sheet1? (if so you will need to use this form of referencing)

Workbooks("Book1").Sheet1.Range("A65536").End(xlUp).Offset(1, 0)

Have a look at this article for more on this.

HTH,
John

[Philcjr]

John,

Thanks for your post.

The sheet tab has a CODE name of "Sheet1" and the tab itself is named "Sheet1".

I still struggle with the idea that when this code executes, the file in which I am trying to copy the data to is not the "Active" workbook... hence why I believe the code to breaks.

I have sent a copy of the files to Zack, as there is some sensitive company data, hopefully he can understand where the error is. If it is fixed, I will later post the code for others to benefit.

Thanks,
Phil

[Norie]

Phil

Have you checked that you have the correct names in vlist? Including any trailing/leading spaces.

Also have you considered just looping through all the worksheets rather than using an array.

[BDavidson]

Try changing (note the name for the Workbook):

.Range(.Range("A65536").End(xlUp), .Range("L2")).Copy _
    Workbooks("Book1").Worksheets(Sheet1).Range("A65536").End(xlUp).Offset(1, 0)

to

.Range(.Range("A65536").End(xlUp), .Range("L2")).Copy _
    Workbooks("Book1.xls").Worksheets(Sheet1).Range("A65536").End(xlUp).Offset(1, 0)

[Philcjr]

Norie,

Yes, the names in the vlist are correct.

The code used was originally used in the same file "GA_Spreadsheet_07-19-05" and worked. This was a feature I created for an Admin/manager to login to the file and get a summary for the data onto one sheet for their review.

After this file was in place, I amount of data was getting quite large. So I desiced to break the code out of the file "GA_Spreadsheet_07-19-05" and place it into a seperate file for just the Admins/Managers.

[Philcjr]

Barry,

We are onto something....

Let me play and I will post again...

Phil

[Philcjr]

All,

Thank you for all that have helped me with this problem. In short, this problem has been solved.... Thanks Barry.

Please don't close out this post, as I wish to finalize the coding and formats so that I can post the code for all to benefit.

Thanks again,
Phil

[Zack Barresse]

Wow! Barrie! We all couldn't see the forest for the trees, could we! Sometimes, it just bites you in the bum .. LOL! Good one!

[BDavidson]

We all couldn't see the forest for the trees, could we!

I really hate when I have days like that (all too often now that I've passed 40!).

[Philcjr]

Finally, I have the file they way I need it to be. Below is the code which is linked to a command button.

Thank you all for your help

ps. if there are any ways of making this code pretier/better... VERY open to suggestions and willing to learn.

Option Explicit

Sub Get_Data()
Dim wk As Worksheet
Dim x As Integer
Dim vlist
ChDir "C:\Documents and Settings\collinp\Desktop"
Application.EnableEvents = False
Workbooks.Open Filename:= _
    "C:\Documents and Settings\collinp\Desktop\GA_Spreadsheet_07-19-05.xls"
For Each wk In Worksheets
    wk.Visible = True
Next
vlist = Array("Gloria Goodrich", "Kia Kelley", "Jeff Shonk", _
                "Laura DiFrancesco", "Rick Gribbin", "Other")
For x = 0 To UBound(vlist)
    With Worksheets(vlist(x))
        If Not IsEmpty(.Range("A2")) Then
            .Range(.Range("A65536").End(xlUp), .Range("L2")).Copy _
            Workbooks("Book1.xls").Worksheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0)
        End If
    End With
Next
Workbooks("Book1.xls").Activate
Worksheets("Sheet1").Select
Cells.Select
    With Selection
        .VerticalAlignment = xlCenter
        .FormatConditions.Delete
    End With
Columns("A:L").ColumnWidth = 70
Columns("A:L").AutoFit
Rows().AutoFit
Rows("2").Select
ActiveWindow.FreezePanes = True
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2"), _
         Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A2").Select
Application.EnableEvents = True
Workbooks("GA_Spreadsheet_07-19-05.xls").Close SaveChanges:=False
MsgBox ("Data copy now complete." & vbCrLf & vbCrLf & "You are now free to use AutoComponent Filter and other Sort Functions")
End Sub

[Zack Barresse]

Well, you can shorten this ...

Workbooks("Book1.xls").Activate 
    Worksheets("Sheet1").Select 
    Cells.Select 
    With Selection 
        .VerticalAlignment = xlCenter 
        .FormatConditions.Delete 
    End With 
Columns("A:L").ColumnWidth = 70 
    Columns("A:L").AutoFit 
    Rows().AutoFit 
    Rows("2").Select 
    ActiveWindow.FreezePanes = True 
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2"), _ 
    Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom 
    Range("A2").Select

.. to this ...

With Workbooks("Book1.xls").Worksheets("Sheet1")
    .Cells.VerticalAlignment = xlCenter
    .Cells.FormatConditions.Delete
    .Columns("A:L").AutoFit 
    .Rows.AutoFit 
    .Rows("2").Select
    ActiveWindow.FreezePanes = True 
    .Rows("2").Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2")
End With

Other than that, it's not bad. Glad you got it working!!!