copy to new workbook

[tcarter963]

I'm trying to copy some data to a new workbook all on one worksheet from multiple sheets in another workbook. My code keeps breaking at the point where it makes a new workbook (.SaveAs Filename). It gives runtime error 1004. I'm not sure I have the copy values set correctly either but can't test it because the code breaks before then. Any help would be really appreciated.

Option Explicit

Sub Cp2NewWorkBook()

Dim Newbook As Workbook
Dim strName As String
    
    strName = InputBox(Prompt:="Enter Project Number", _
    Title:="Save Averaged data in database project folder", _
    Default:="12000")
    
    On Error GoTo ErrHandler:
ErrHandler:
    If Err.Number = 76 Then
    MsgBox "The folder for this project has not been created yet, the path cannot be found.", vbInformation
    Exit Sub
    
    End If

    If strName = "12000" Or strName = vbNullString Then
    
    Exit Sub
    
        Else
        
Set Newbook = Workbooks.Add
    With Newbook
        .Title = "Average Results"
        .Subject = "Ave"
        .SaveAs Filename:="N:\_HPLCDatabase\" & strName & "\AveReuslts.xls"
    End With

End If

Dim WS As Worksheet
Dim LastRowColumnA As Long
Dim LastRowColumnBA As Long
Dim wbX As Workbook


Set wbX = ActiveWorkbook



For Each WS In wbX
  

   Application.ScreenUpdating = False
   
    LastRowColumnBA = wbX.WS.Range("BA301").End(xlUp).Row
    LastRowColumnA = Newbook.Range("A3000").End(xlUp).Row
    
    Newbook.Range("A1:J" & LastRowColumnA).Value = WS.Range("BA2:BJ" & LastRowColumnBA).Value
           
           On Error Resume Next
    
    Next WS
 
  Application.ScreenUpdating = True
   
End Sub

 

[JoeMo]

Maybe the path (N:\_HPLCDatabase ....\) is not valid. Do you have an N drive?

 

[tcarter963]

So instead of saving to a new workbook I'm trying to save to a new worksheet. This way I won't have to worry about the file path as well as saving over the Workbook with the next set of data.

The only problem is this new code works for creating a new worksheet by I've screwed something up on copying the values. I get a blank worksheet name ave, but no values.

Option Explicit

Sub Cp2Worksheet()

Dim NewSheet As Worksheet
Dim WS As Worksheet
Dim LastRowColumnA As Long
Dim LastRowColumnBA As Long

Set NewSheet = Sheets.Add(After:=Worksheets(Worksheets.Count))
        
   With NewSheet
        .Name = "Ave"
   End With


For Each WS In ActiveWorkbook.Worksheets
 

   Application.ScreenUpdating = False
   
    LastRowColumnBA = WS.Range("BA301").End(xlUp).Row
    LastRowColumnA = NewSheet.Range("A3000").End(xlUp).Row
    
    NewSheet.Range("A1:J" & LastRowColumnA).Value = WS.Range("BA2:BJ" & LastRowColumnBA).Value
           
           On Error Resume Next
    
    Next WS
 
  Application.ScreenUpdating = True
   
End Sub

 

[tcarter963]

Copying down a worksheet from multiple worksheets is presenting some problems for me. This is where I'm at with modifying the previous code. It's still not working. Any help would be greatly appreciated.

Dim NewSheet As Worksheet
Dim WS As Worksheet
Dim LastRowColumnA As Long
Dim LastRowColumnBA As Long

Set NewSheet = Sheets.Add(After:=Worksheets(Worksheets.Count))
        
   With NewSheet
        .Name = "Ave"
   End With


For Each WS In ActiveWorkbook.Worksheets
 

   Application.ScreenUpdating = False
   
    LastRowColumnBA = WS.Range("BA301").End(xlUp).Row
    LastRowColumnA = NewSheet.Range("A5000").End(xlUp).Row
    
    NewSheet.Range("A" & LastRowColumnA, ":J" & LastRowColumnBA + LastRowColumnA).Value = WS.Range("BA2:BJ" & LastRowColumnBA).Value
           
           On Error Resume Next
    
    Next WS
 
  Application.ScreenUpdating = True
   
End Sub

 

[JoeMo]

Don't you want to exclude the new sheet when you loop through the sheets in the workbook? For example:

For Each WS In ActiveWorkbook.Worksheets
    If WS.Name <> "Ave" Then
     ... code ...
    End if
Next WS
....

 

[tcarter963]

Yes, thanks a bunch.
I was wondering if I needed to do that. I wasn't sure, but I thought it might not matter.

 

[tcarter963]

I'm still having issues with the copy portion on the code. The range in each worksheet will vary in length down a column. I'm pasting to the new worksheet but would like to copy the data down the column. I've tried various combination's, but no luck yet.

Option Explicit

Sub Cp2Worksheet()

Dim NewSheet As Worksheet
Dim WS As Worksheet
Dim LRowBA As Long
Dim LRowA As Long

Set NewSheet = Sheets.Add(After:=Worksheets(Worksheets.Count))
        
   With NewSheet
        .Name = "Ave"
   End With

For Each WS In ActiveWorkbook.Worksheets
     
 If WS.Name <> "Ave" Then
    
   Application.ScreenUpdating = False
   
    LRowBA = WS.Range("BA301").End(xlUp).Row
    LRowA = Sheets("Ave").Range("A6000").End(xlUp).Row
    
    
    Sheets("Ave").Range("A" & LRowA + 1 & Range("J" & LRowBA + LRowA)).Value = WS.Range("BA2:BJ" & LRowBA).Value

    ' Sheets("Ave").Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).Value = WS.Range("BA2:BJ" & LRowBA).Value
           
           On Error Resume Next
  End If
    Next WS
 
 
  Application.ScreenUpdating = True
   
End Sub

 

[JoeMo]

Can you be more specific about the issues you are having?

One potential problem I see is that the range in Sheet "Ave" you are placing values on may be of a different length (number of cells) than the range on sheet WS you are using to assign the values to the "Ave" range. If the range on Ave is longer than the one on WS, you will get a #NA error on the 'extra' cells on Ave.

 

[tcarter963]

Joe,

The code that I had so far would only return one value to the cell A1 in the new sheet. I think that you're correct in that the ranges didn't match up but I think that there were more issues than that. I'm not very good with vba, hence having to ask for so much help. This is a great resource and I appreciate the help.

I was able to find some help from google once I had a better idea for what I need to search for. http://msdn.microsoft.com/en-us/li...pleSheets_CopyAllDatafromMultipleWorksheets)

This wasn't exactly what I needed but I was able to modify the code eventually to get 99% of the way there. The trouble was with my spreadsheet I didn't want to consolidate the data starting from A1.