VBA CODE FROM EXCEL TO POW

Olá, pessoal, bom dia, tudo bem? Poderiam me ajudar a melhorar o código abaixo? Fiz sozinho, sem conhecimento prévio, e ele funciona as vezes....rs - as vezes da erro. Coisas que eu queria melhorar: Dar opção ao usuário escolher a origem do arquivo, ao invés de ele ser obrigado a deixar o arquivo salvo no C:\Users\Public\filename.pptx. Outra coisa, meu código é tão amador que ele copia e cola 1900x o mesmo item, mas de celulas diferentes. Quando as informações chegam no Powerpoint, elas estão sendo coladas nos campos corretos, da maneira correta. Alguém pode me ajudar, por favor? Sub PasteExcelDataIntoPowerPointTextbox() Dim ppApp As Object Dim ppSlide As Object Dim ppTextBox As Object Dim xlApp As Excel.Application Dim xlWorkbook As Excel.Workbook Dim xlWorksheet As Excel.Worksheet Dim excelRange As Excel.Range ' Initialize PowerPoint and Excel Set ppApp = CreateObject("PowerPoint.Application") ppApp.Visible = True ' Make PowerPoint visible ' Open the PowerPoint presentation Set ppPresentation = ppApp.Presentations.Open("C:\Users\Public\filename.pptx") ' Assuming the Excel file is already open, else you can open it too Set xlApp = GetObject(, "Excel.Application") Set xlWorkbook = xlApp.ActiveWorkbook Set xlWorksheet = xlWorkbook.Worksheets("HiringResults") ' Change to your sheet name ' Get the range of Excel data you want to copy Set excelRange = xlWorksheet.Range("C1") Set ppSlide = ppPresentation.Slides(1) Set ppTextBox = ppSlide.Shapes("REFTYPE").TextFrame.TextRange excelRange.Copy ppTextBox.Paste Set excelRange = xlWorksheet.Range("C2") Set ppSlide = ppPresentation.Slides(1) Set ppTextBox = ppSlide.Shapes("REFBUSINESS").TextFrame.TextRange excelRange.Copy ppTextBox.Paste Set excelRange = xlWorksheet.Range("D3") Set ppSlide = ppPresentation.Slides(1) Set ppTextBox = ppSlide.Shapes("REFNUMBERFILLS").TextFrame.TextRange excelRange.Copy ppTextBox.Paste Set excelRange = xlWorksheet.Range("D4") Set ppSlide = ppPresentation.Slides(1) Set ppTextBox = ppSlide.Shapes("REFVARIATION").TextFrame.TextRange excelRange.Copy ppTextBox.Paste Set excelRange = xlWorksheet.Range("D5") Set ppSlide = ppPresentation.Slides(1) Set ppTextBox = ppSlide.Shapes("REFTTF").TextFrame.TextRange excelRange.Copy ppTextBox.Paste Set excelRange = xlWorksheet.Range("D6") Set ppSlide = ppPresentation.Slides(1) Set ppTextBox = ppSlide.Shapes("REFCNPS").TextFrame.TextRange excelRange.Copy ppTextBox.Paste Set excelRange = xlWorksheet.Range("D7") Set ppSlide = ppPresentation.Slides(1) Set ppTextBox = ppSlide.Shapes("REFHMNPS").TextFrame.TextRange excelRange.Copy ppTextBox.Paste Set excelRange = xlWorksheet.Range("D8") Set ppSlide = ppPresentation.Slides(1) Set ppTextBox = ppSlide.Shapes("REFACTREQ").TextFrame.TextRange excelRange.Copy ppTextBox.Paste Set excelRange = xlWorksheet.Range("D9") Set ppSlide = ppPresentation.Slides(1) Set ppTextBox = ppSlide.Shapes("REFDIVMALE").TextFrame.TextRange excelRange.Copy ppTextBox.Paste Set excelRange = xlWorksheet.Range("D10") Set ppSlide = ppPresentation.Slides(1) Set ppTextBox = ppSlide.Shapes("REFDIVFAME").TextFrame.TextRange excelRange.Copy ppTextBox.Paste Set excelRange = xlWorksheet.Range("D11") Set ppSlide = ppPresentation.Slides(1) Set ppTextBox = ppSlide.Shapes("REFHIREINT").TextFrame.TextRange excelRange.Copy ppTextBox.Paste Set excelRange = xlWorksheet.Range("D12") Set ppSlide = ppPresentation.Slides(1) Set ppTextBox = ppSlide.Shapes("REFHIREEXT").TextFrame.TextRange excelRange.Copy ppTextBox.Paste Set excelRange = xlWorksheet.Range("D13") Set ppSlide = ppPresentation.Slides(1) Set ppTextBox = ppSlide.Shapes("REFTSTASO").TextFrame.TextRange excelRange.Copy ppTextBox.Paste Set excelRange = xlWorksheet.Range("D14") Set ppSlide = ppPresentation.Slides(1) Set ppTextBox = ppSlide.Shapes("REFTSEMRE").TextFrame.TextRange excelRange.Copy ppTextBox.Paste Set excelRange = xlWorksheet.Range("D15") Set ppSlide = ppPresentation.Slides(1) Set ppTextBox = ppSlide.Shapes("REFTSAGENC").TextFrame.TextRange excelRange.Copy ppTextBox.Paste Set excelRange = xlWorksheet.Range("D16") Set ppSlide = ppPresentation.Slides(1) Set ppTextBox = ppSlide.Shapes("REFLEVEX").TextFrame.TextRange excelRange.Copy ppTextBox.Paste Set excelRange = xlWorksheet.Range("D17") Set ppSlide = ppPresentation.Slides(1) Set ppTextBox = ppSlide.Shapes("REFLEVDI").TextFrame.TextRange excelRange.Copy ppTextBox.Paste Set excelRange = xlWorksheet.Range("D18") Set ppSlide = ppPresentation.Slides(1) Set ppTextBox = ppSlide.Shapes("REFLEVMA").TextFrame.TextRange excelRange.Copy ppTextBox.Paste Set excelRange = xlWorksheet.Range("D19") Set ppSlide = ppPresentation.Slides(1) Set ppTextBox = ppSlide.Shapes("REFLEVIN").TextFrame.TextRange excelRange.Copy ppTextBox.Paste Set excelRange = xlWorksheet.Range("D20") Set ppSlide = ppPresentation.Slides(1) Set ppTextBox = ppSlide.Shapes("REFDATAREF").TextFrame.TextRange excelRange.Copy ppTextBox.Paste Set excelRange = xlWorksheet.Range("D21") Set ppSlide = ppPresentation.Slides(1) Set ppTextBox = ppSlide.Shapes("REFKEYINSIGHTS").TextFrame.TextRange excelRange.Copy ppTextBox.Paste ' Clean up Set ppApp = Nothing Set xlApp = Nothing Set xlWorkbook = Nothing Set xlWorksheet = Nothing Set ppPresentation = Nothing MsgBox "Report completed. Please edit and save it." End Sub