Option Explicit
Sub CopyProposal()
Dim cfwb As Workbook
Dim ctwb As Workbook
Dim cfws As Worksheet
Dim ctws As Worksheet
Dim i As Integer
Dim answer1 As Integer
Dim ctnr As Integer
Dim ProposalFN As String
Dim cncl As Boolean
Dim MoreFiles As Boolean
cncl = False
MoreFiles = True
Do Until MoreFiles = False
ProposalFN = Application.GetOpenFilename _
(Title:="Please choose the Proposal file to Open", _
FileFilter:="Excel Files *.xls* (*.xls*),")
If ProposalFN = "False" Then
cncl = True
MsgBox "No Proposal file was specified." & vbCrLf & vbCrLf & "Code Execution will be Aborted.", , vbExclamation
GoTo CheckCncl
Else
Set cfwb = Workbooks.Open(ProposalFN)
Set cfws = cfwb.Sheets("Proposal")
Set ctwb = ThisWorkbook
Set ctws = ctwb.Sheets("All Proposals")
End If
ctnr = ctws.Cells(ctws.Rows.Count, "A").End(xlUp).Row + 1
ctws.Cells(ctnr, "A").Value = cfws.Range("E6")
ctws.Cells(ctnr, "B").Value = cfws.Range("K3")
ctws.Cells(ctnr, "C").Value = cfws.Range("K4")
ctws.Cells(ctnr, "D").Value = cfws.Range("K5")
ctws.Cells(ctnr, "E").Value = cfws.Range("K6")
ctws.Cells(ctnr, "F").Value = cfws.Range("K8")
ctws.Cells(ctnr, "G").Value = cfws.Range("C9")
ctws.Cells(ctnr, "H").Value = cfws.Range("C10")
ctws.Cells(ctnr, "I").Value = cfws.Range("C11")
ctws.Cells(ctnr, "J").Value = cfws.Range("C12")
ctws.Cells(ctnr, "K").Value = cfws.Range("C14")
ctws.Cells(ctnr, "L").Value = cfws.Range("G9")
ctws.Cells(ctnr, "M").Value = cfws.Range("G10")
ctws.Cells(ctnr, "N").Value = cfws.Range("G11")
ctws.Cells(ctnr, "O").Value = cfws.Range("G12")
ctws.Cells(ctnr, "P").Value = cfws.Range("G14")
ctws.Cells(ctnr, "Q").Value = cfws.Range("K10")
ctws.Cells(ctnr, "R").Value = cfws.Range("K11")
ctws.Cells(ctnr, "S").Value = cfws.Range("K12")
cfwb.Close SaveChanges:=False
answer1 = MsgBox("Add another Proposal File?", vbYesNo)
Select Case answer1
Case vbNo
MoreFiles = False
End Select
Loop
CheckCncl:
ThisWorkbook.Activate
End Sub