Code copy nhiều sheets và rename

[alonelove]

Lại chào Anh/Chị ạ.

Em có vấn đề thế này, hiện em có đoạn code brown to folder chọn 01 file excel để copy các sheets chỉ định gồm Sheets(array("source1","source2","source3","source4") sau đó dán vào workbook hiện hành.
Vấn đề của em là workbook hiện hành luôn có các sheet "source1","source2","source3","source4" nên excel mẵ định các sheet mới copy vào nó có thêm (1) ví dụ sheets("source1 (1)")

Vậy phiền anh chị giúp em sửa code sau hoặc có phương án khả thi hơn để copy và đổi tên sheet như sau:
sheets từ file nguồn Sheets(array("source1","source2","source3","source4")
sang file đích là Sheets(array("BC","BC2","BC3","BC4")

Em xin cảm ơn ạ./.

Sub ImportSheets()
 Dim DestWb As Workbook
 Dim SourceWb As Workbook
Dim SourceName As Variant
  Set DestWb = ActiveWorkbook

 SourceName = Application.GetOpenFilename
 Workbooks.Open fileName:=SourceName
 Set SourceWb = ActiveWorkbook
SourceWb.Sheets(array("source1","source2","source3","source4").Copy After:=DestWb.Sheets(DestWb.Sheets.Count)
 
SourceWb.Close
End Sub

 

[HeSanbi]

Sửa code lại xem sao.

Sub ImportSheets()
Dim DestWb As Workbook
Dim SourceWb As Workbook
Dim SourceName As Variant
  Set DestWb = ActiveWorkbook
Dim arr , i ,iCount
SourceName = Application.GetOpenFilename
Workbooks.Open fileName:=SourceName
Set SourceWb = ActiveWorkbook
arr = array("BC","BC2","BC3","BC4")
iCount  = DestWb.Sheets.Count
SourceWb.Sheets(arr).Copy After:=DestWb.Sheets(DestWb.Sheets.Count)
SourceWb.Close
for i = 1 to ubound(arr) + 1
DestWb.Sheets(iCount + i).name = arr(i -1)
next

End Sub