copy form one WB and paste in a different WB

[dub]

Hello, I am kinda new to VBA and I am sure this code is very messy. However, I am trying to paste a selection of data from one workbook into another workbook. The code I have written allows the user to open the wb where the data is and a template wb for pasting the data into. I run into problems when trying to paste into the desired wb. I want to paste the data into the wb named "Results" which should be the the template the user opened, resaved as what ever they choose, but named "Results" so that the code knows what wb I am refering to. Does this make sence?
Here is the code so far, the copy/paste selection are all at the bottom, most are commented out b/c once I get one to work I can get the rest. Thanks.



Sub AsBuiltCreate()
'
' AsBuiltCreator Program
' Copies desired rows/columns and puts them in new work book in proper format
'
' By Eric Schaub, LMCO intern
' Program Created: 11/16/2010
'
Dim MySelection As Range
Dim Resutls As Variant
Dim AddrString As String, AddrLength As Integer, FirstStrip As String
Dim Charnum As Integer, ColonCharNum As Integer, FirstNum As Integer
Dim SecondNum As Integer
Dim Results As Workbook
Dim asbuilt As Workbook
m = MsgBox("Double left mouse click on the template file.", , "Select Template") 'prompts to locate template file
Template = Application.GetOpenFilename("Excel Files (*.xlsx;*.xls;*.dat;*.XLS), *.xlsx;*.xls;*.dat;*.XLS", , "Open the Template") 'opens browser window

Line0:
If Template = "False" Then 'gives error message if no file is selected and gives the option to retry or stop
E = MsgBox("Must select a Template File.", vbExclamation + vbRetryCancel, "Error")
If E = vbRetry Then
Template = Application.GetOpenFilename("Excel Files (*.xlsx;*.xls;*.dat;*.XLS), *.xlsx;*.xls;*.dat;*.XLS", , "Open the Template") 'opens browser window
GoTo Line0
ElseIf E = vbCancel Then
Exit Sub
End If
End If

m = MsgBox("Double left mouse click the As-Built File.", , "Select AD FILE") 'prompts to locate AB file
AB = Application.GetOpenFilename("Excel Files (*.xls;*.dat;*.XLS;*.xlsx), *.xls;*.dat;*.XLS;*.xlsx", , "Open the AB FILE") 'opens browser window
Line1:
If AB = "False" Then 'gives error message if no file is selected and gives the option to retry or stop
E = MsgBox("Must enter an AB file.", vbExclamation + vbRetryCancel, "Error")
If E = vbRetry Then
AB = Application.GetOpenFilename("Excel Files (*.xls;*.dat;*.XLS;*.xlsx), *.xls;*.dat;*.XLS;*.xlsx", , "Open the AD FILE")
GoTo Line1
ElseIf E = vbCancel Then
Exit Sub
End If
End If

Application.ScreenUpdating = False
'Open AB
Workbooks.Open Filename:=AB
asbuilt = ActiveWorkbook.Name

'Open template
Workbooks.Open Filename:=Template
Results = ActiveWorkbook.Name

Results = Application.GetSaveAsFilename("C:\Temp\File.xls", _
"Workbook (*.xls), *.xls", , "Save As:")

Line2:
If Results = False Then
E = MsgBox("Must specify name and location.", vbExclamation + vbRetryCancel, "Error")
If E = vbRetry Then
Results = Application.GetSaveAsFilename("C:\Temp\File.xls", _
"Workbook (*.xls), *.xls", , "Save As:")
GoTo Line2
ElseIf E = vbCancel Then
Exit Sub
End If
End If

DataSelection:
'Open AB
Workbooks.Open Filename:=AB
asbuilt = ActiveWorkbook.Name
Set asbuilt = ActiveWorkbook
Application.ScreenUpdating = True
Set MySelection = Application.InputBox(Prompt:="Select a range of cells", Type:=8)
MySelection.Select
'If MySelection = "" Then 'gives error message if no rows are selected and gives the option to retry or stop
'E = MsgBox("Must select at least one row", vbExclamation + vbRetryCancel, "Error")
'If E = vbRetry Then
'GoTo DataSelection
' ElseIf E = vbCancel Then
'Exit Sub
' End If
' End If
AddrString = Selection.Address
AddrLength = Len(AddrString)
FirstStrip = Right(AddrString, AddrLength - 1)
For Charnum = 1 To AddrLength - 1
If Mid(FirstStrip, Charnum, 1) = ":" Then
ColonCharNum = Charnum
Exit For
End If
Next Charnum
start_row = Left(FirstStrip, ColonCharNum - 1)
end_row = Right(FirstStrip, AddrLength - 2 - ColonCharNum)
int_row = 3
paste_row = int_row
'Data Manipulation
Range("H" & start_row & ":H" & end_row).Select
Selection.Copy

Sheet2.Activate
Range("K" & paste_row).Select
Sheet2.Paste

'Windows(asbuilt).Activate
'Range("J" & start_row & ":J" & end_row).Select
'Application.CutCopyMode = False
'Selection.Copy

'Windows(Results).Activate
'Range("L" & paste_row).Select
'Sheet1.Paste

'Set asbuilt = ActiveWorkbook
'Sheet1.Activate
'Range("N" & start_row & ":N" & end_row).Select
'Application.CutCopyMode = False
'Selection.Copy

'Windows(Results).Activate
'Range("A" & paste_row).Select
'Sheet2.Paste

'Windows(asbuilt).Activate
'Range("O" & start_row & ":O" & end_row).Select
'Application.CutCopyMode = False
'Selection.Copy

'Windows(Results).Activate
'Range("C" & paste_row).Select
'Sheet2.Paste

'Windows(asbuilt).Activate
'Range("P" & start_row & ":P" & end_row).Select
'Application.CutCopyMode = False
'Selection.Copy

'Windows(Results).Activate
'Range("H" & paste_row).Select
'Sheet2.Paste

'Windows(asbuilt).Activate
'Range("T" & start_row & ":T" & end_row).Select
'Application.CutCopyMode = False
'Selection.Copy

'Windows(Results).Activate
'Range("N" & paste_row).Select
'Sheet2.Paste

'Windows(asbuilt).Activate
'Range("X" & start_row & ":X" & end_row).Select
'Application.CutCopyMode = False
'Selection.Copy

'Windows(Results).Activate
'Range("D" & paste_row).Select
'Sheet2.Paste

'Windows(asbuilt).Activate
'Range("AA" & start_row & ":AA" & end_row).Select
'Application.CutCopyMode = False
'Selection.Copy

'Windows(Results).Activate
'Range("I" & paste_row).Select
'Sheet2.Paste

'Windows(asbuilt).Activate
'Range("AB" & start_row & ":AB" & end_row).Select
'Application.CutCopyMode = False
'Selection.Copy

'Windows(Results).Activate
'Range("J" & paste_row).Select
'Sheet2.Paste

Done = MsgBox(Prompt:="Do you wish to select more data", _
Buttons:=vbYesNo, Title:="Finished?")
If Done = vbYes Then
GoTo DataSelection
ElseIf Done = vbNo Then
Exit Sub
End If
paste_row = paste_row + (end_row - start_row)

End Sub

thanks

[Bob Phillips]

Just use code like



Workbooks(asbuilt).Range("J" & start_row & ":J" & end_row).Copy _
Workbooks(Results).Range("L" & paste_row)

[dub]

thanks i will try this

[dub]

I am getting an error with this.... Run-time error '13': Type mismatch

[dub]

Have i defined asbuilt and Results correctly as the names of the two workbooks that were opened by the user?

[Bob Phillips]

Do you ever open the Results workbook?

[dub]

The user opens a workbook that is a template which has the correct headings and such, by

Template = Application.GetOpenFilename("Excel Files (*.xlsx;*.xls;*.dat;*.XLS), *.xlsx;*.xls;*.dat;*.XLS", , "Open the Template") 'opens browser window

Then I have the user resave over the template with a name of their choosing as to not lose the template so it can be used over and over again. I do the resave by (which may not corret) opening the workbook, naming it "Results" then do the save as,

Workbooks.Open Filename:=Template
Results = ActiveWorkbook.Name

Results = Application.GetSaveAsFilename("C:\Temp\File.xls", _
"Workbook (*.xls), *.xls", , "Save As:")

This may be a bad way of doing this. All i want to do is open a file and save it as somthing new of the users choice, then be able to call it and paste into it later.
Thanks for your time.

[Bob Phillips]

This code doesn't make much sense to me



'Open template
Workbooks.Open Filename:=Template
Results = ActiveWorkbook.Name

Results = Application.GetSaveAsFilename("C:\Temp\File.xls", _
"Workbook (*.xls), *.xls", , "Save As:")


You open the workbook and set Results to its name, then reset Results to a potential save file name. Why?

If, that is If, Results is the name of the file you opened then that code that I gave should work, so I guess it is has got corrupted along the way.

[Sean.DiSanti]

Just use code like



Workbooks(asbuilt).Range("J" & start_row & ":J" & end_row).Copy _
Workbooks(Results).Range("L" & paste_row)

should be...

looks like you're referencing worksheet ranges from workbook object... maybe try:
[vba]
Workbooks(asbuilt).ActiveSheet.Range("J" & start_row & ":J" & end_row).Copy _
Workbooks(Results).Worksheets(1).Range("L" & paste_row)

[dub]

got it... thanks folks! :beerchug: