Copy data from different workbook and paste it to specific sheets on a report workbook

Question

Currently i am new on studying VBA for reporting and im still learning from it. moving on, may i ask a help on this one? :), my scenario is this.

• i have data on 20 workbooks (POLY, BAYO, PROPO, TIPAS, CITRO....etc) with sheet name (Sheet1)
• i have a single workbook for summary with many sheets, its sheet name is based on 20 workbook file name but not in alphabetical order. (Sheet name = CITRO, BAYO, PROPO, POLY, TIPAS....etc)
• i want to copy the data on each workbook and paste it to their respective sheet name based on file name and specific cell ("B2:F2")
• is it doable?

here's the code im trying to work on, the problem is, it is creating its own sheet instead of pasting it to my desire sheet.

---

Private Sub CommandButton1_Click()

Dim SourceBook As Workbook   
Dim CurrentBook As Workbook

application.screenupdating = false
Set CurrentBook = ThisWorkbook

Set SourceBook = Workbooks.Open("C:\CITRO.xlsx")
SourceBook.Sheets("Sheet1").Range("B2:F2").Copy Destination:=CurrentBook.Sheets("CITRO").Range("R2:V2")

Set SourceBook = Workbooks.Open("C:\BAYO.xlsx")
SourceBook.Sheets("Sheet1").Range("B2:F2").Copy Destination:=CurrentBook.Sheets("BAYO").Range("R2:V2")

Set SourceBook = Workbooks.Open("C:\PROPO.xlsx")
SourceBook.Sheets("Sheet1").Range("B2:F2").Copy Destination:=CurrentBook.Sheets("PROPO").Range("R2:V2")

MsgBox "Completed"
Application.Workbooks("CITRO").Close
Application.Workbooks("BAYO").Close
Application.Workbooks("PROPO").Close
'SourceBook.Close
'Set SourceBook = Nothing
'Set CurrentBook = Nothing

'ThisWorkbook.Activate
'Application.Worksheets("Summary").Activate
'Application.Worksheets("Summary").Range("B2:F2").Select

End Sub

Answer 1

You need to close the SourceBook before opening a new one with SourceBook.Close SaveChanges:=False

Private Sub CommandButton1_Click()
    Dim SourceBook As Workbook   
    Dim CurrentBook As Workbook

    Application.ScreenUpdating = False 'don't forget to activate it in the end
    Set CurrentBook = ThisWorkbook

    Set SourceBook = Workbooks.Open("C:\CITRO.xlsx")
    SourceBook.Worksheets("Sheet1").Range("B2:F2").Copy Destination:=CurrentBook.Worksheets("CITRO").Range("R2:V2")
    SourceBook.Close SaveChanges:=False

    Set SourceBook = Workbooks.Open("C:\BAYO.xlsx")
    SourceBook.Worksheets("Sheet1").Range("B2:F2").Copy Destination:=CurrentBook.Worksheets("BAYO").Range("R2:V2")
    SourceBook.Close SaveChanges:=False

    Set SourceBook = Workbooks.Open("C:\PROPO.xlsx")
    SourceBook.Worksheets("Sheet1").Range("B2:F2").Copy Destination:=CurrentBook.Worksheets("PROPO").Range("R2:V2")
    SourceBook.Close SaveChanges:=False

    Application.ScreenUpdating = True        
    MsgBox "Completed"
End Sub

---

Alternatively you can use a procedure to shorten it:

Private Sub CommandButton1_Click()        
    Application.ScreenUpdating = False 'don't forget to activate it in the end

    CopyIntoThisWorkbook "C:\CITRO.xlsx", "CITRO"
    CopyIntoThisWorkbook "C:\BAYO.xlsx", "BAYO"
    CopyIntoThisWorkbook "C:\PROPO.xlsx", "PROPO"

    Application.ScreenUpdating = True        
    MsgBox "Completed"
End Sub


Private Sub CopyIntoThisWorkbook(ByVal SourceFileName As String, ByVal DestinationSheetName As Range)
    Dim SourceBook As Workbook
    Set SourceBook = Workbooks.Open(SourceFileName)
    SourceBook.Worksheets("Sheet1").Range("B2:F2").Copy Destination:=ThisWorkbook.Worksheets(DestinationSheetName).Range("R2:V2")
    SourceBook.Close SaveChanges:=False
End Sub

---

And if the sheet name CITRO is always the filename CITRO.xlsx then you can even use an array with a loop:

Private Sub CommandButton1_Click()        
    Application.ScreenUpdating = False 'don't forget to activate it in the end
    Dim SheetNameList() As Variant
    SheetNameList = Array("CITRO", "BAYO", "PROPO") 'easily extendable

    Dim SheetName As Variant
    For Each SheetName In SheetNameList
        CopyIntoThisWorkbook SheetName
    Next SheetName

    Application.ScreenUpdating = True        
    MsgBox "Completed"
End Sub


Private Sub CopyIntoThisWorkbook(ByVal DestinationSheetName As String)
    Dim SourceBook As Workbook
    Set SourceBook = Workbooks.Open("C:\" & DestinationSheetName & ".xlsx")
    SourceBook.Worksheets("Sheet1").Range("B2:F2").Copy Destination:=ThisWorkbook.Worksheets(DestinationSheetName).Range("R2:V2")
    SourceBook.Close SaveChanges:=False
End Sub