Copying A Sheet from One Workbook to Another with VBA

[UncleBajubjubs]

Hello, I have a workbook, "Purchasing Workbook", which has a worksheet called "Vendor Data" on which a list of parts is manually entered in, then sent to whomever to purchase the parts. The parts are determined by a different workbook "Data Workbook", and the information is then manually entered into the "Vendor Data" worksheet in "Purchasing Workbook".


To make it so the information doesn't have to be manually entered after it's been calculated, I copied the "Vendor Data" worksheet into "Data Workbook", and then had all the cells auto-fill with the correct parts information. My goal is that after "Vendor Data" is completely filled in on the "Data Workbook", the user presses a button in the "Data Workbook" to copy it over to "Purchasing Workbook" either directly on the sheet, or it makes a new sheet and the old one is deleted.


As both "Purchasing Workbook" and "Data Workbook" are templates that will be saved as new documents with the name of the project they are for, I had to write the code to open a dialog box allow the user to pick which file to open and copy the data to.


I wrote code to do this, but didn't realize "Purchasing Workbook" is a 1997-2003 document, and "Data Workbook" is the newest version. Trying to copy the sheet gives the error "Excel cannot insert the sheets into the destination workbook, because it contains fewer rows and columns than the source workbook. To move or copy the data to the destination workbook, you can select the data, and then use Copy and Paste commands to insert it into the sheets of another workbook.".


So now I'm stuck again. Is there another way to do this? The data on the worksheet is entirely contained through A1-AJ191, so I'm thinking there's a way to just copy that range, but don't know exactly how I'd code it.

Thanks.

 

[NdNoviceHlp]

U can trial copying and pasting the used range of the sheet instead of the whole sheet...

workbooks("Data Workbook").Sheets("Vendor Data").UsedRange.copy _
    Destination:=workbooks("Purchasing Workbook").Sheets("Vendor Data").Range("A1")

Or the specific range...

workbooks("Data Workbook").Sheets("Vendor Data").Range("A1:AJ191").copy _
    Destination:=workbooks("Purchasing Workbook").Sheets("Vendor Data").Range("A1")

Note that this copies the Vendor Data sheet from the Data Workbook to the Purchasing Workbook sheet "Vendor Data" which MUST exist. Note that it will replace all contents including formulas in the paste area. HTH. Dave

 

[UncleBajubjubs]

Hello, I added this in and added a little more code since whoever else uses it will rename both workbooks prior to running the macro, so it needs to set their names as variables. I added

<code>


Sub Copy()


Dim vendorfilename As Variant
Dim VDS As Workbook
Dim BrProgram As Workbook


Set BrProgram = ActiveWorkbook




vendorfilename = Application.GetOpenFilename()

If vendorfilename = False Then Exit Sub
Set VDS = Workbooks.Open(vendorfilename)


BrProgram.Sheets("Vendor Data").Range("A1:AJ191").Copy _
Destination:=VDS.Sheets("Vendor Data").Range("A1")


End Sub

</code>

But that last line gives a type mismatch error with the changes I made, any clues?

 

[NdNoviceHlp]

U can trial this. Dave

ThisWorkbook.Sheets("Vendor Data").Range("A1:AJ191").Copy _
 Destination:=workbooks(VDS.Name).Sheets("Vendor Data").Range("A1")

 

[UncleBajubjubs]

Thanks again,
I gave that a shot, but I'm still seeing

"Run-time error '-2147352565 (80002000b)': Could not set the Value property. Type Mismatch."

 

[NdNoviceHlp]

Dim VDS As Object

Dave

 

[UncleBajubjubs]

Now I'm seeing subscript out of range.

 

[NdNoviceHlp]

Well let's change it all up. Dave

Private Sub test4()
Dim FileNm As Object, Cnt As Integer
Dim TargetFiles As FileDialog
 Set TargetFiles = Application.FileDialog(msoFileDialogOpen)
 With TargetFiles
 .AllowMultiSelect = True
 .Title = "Multi-select target data files:"
 .ButtonName = ""
 .Filters.Clear
 .Filters.Add "*.xls* files", "*.xls*"
 .Show
 End With
If TargetFiles.SelectedItems.Count = 0 Then
 MsgBox "PICK A FILE!"
 Exit Sub
 End If
On Error GoTo below
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Cnt = 1 To TargetFiles.SelectedItems.Count
 'open the file and assign the workbook/worksheet
Set FileNm = Workbooks.Open(TargetFiles.SelectedItems(Cnt))
ThisWorkbook.Sheets("Vendor Data").Range("A1:AJ191").Copy _
 Destination:=Workbooks(FileNm.Name).Sheets("Vendor Data").Range("A1")
Workbooks(FileNm.Name).Close SaveChanges:=False
Next Cnt
below:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
If Err.Number <> 0 Then MsgBox "File Error"
End Sub

 

[UncleBajubjubs]

Alrighty, I actually fixed my original program before I saw you'd replied, the issue seems to have been that the "Vendor Data" sheet in the purchasing workbook had a space after it which I hadn't noticed. I renamed both sheets to make them easier to tell apart.

Now I have

<code>
Sub Copy()


Dim vendorfilename As Variant
Dim VDS As Object
Dim BrProgram As Workbook


Set BrProgram = ActiveWorkbook




vendorfilename = Application.GetOpenFilename()

If vendorfilename = False Then Exit Sub
Set VDS = ActiveWorkbook 'remove this after testing
Set VDS = Workbooks.Open(vendorfilename)


ThisWorkbook.Sheets("Vendor Data Sheets").Range("A1:AJ191").Copy _
Destination:=Workbooks(VDS.Name).Sheets("VENDOR COMP DATA").Range("A1")






End Sub
</code>

which works, and has the new names. My only remaining issue is that it copies over cell formulas instead of just their values. IS this something I'd fix with PasteSpecial, or is there another way to do that?

 

[NdNoviceHlp]

Trial this...

Private Sub test4()
Dim FileNm As Object, Cnt As Integer
Dim TargetFiles As FileDialog
 Set TargetFiles = Application.FileDialog(msoFileDialogOpen)
 With TargetFiles
 .AllowMultiSelect = True
 .Title = "Multi-select target data files:"
 .ButtonName = ""
 .Filters.Clear
 .Filters.Add "*.xls* files", "*.xls*"
 .Show
 End With
If TargetFiles.SelectedItems.Count = 0 Then
 MsgBox "PICK A FILE!"
 Exit Sub
 End If
On Error GoTo below
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Cnt = 1 To TargetFiles.SelectedItems.Count
 'open the file and assign the workbook/worksheet
Set FileNm = Workbooks.Open(TargetFiles.SelectedItems(Cnt))
ThisWorkbook.Sheets("Vendor Data").Range("A1:AJ191").Copy
Workbooks(FileNm.Name).Sheets("Vendor Data").Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
Workbooks(FileNm.Name).Close SaveChanges:=True
Next Cnt
below:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
If Err.Number <> 0 Then MsgBox "File Error"
End Sub

Dave