Help to copy multiple sheet from another WB and rename

[nhnn1986]

Hi all

I want to have macro code to do that:

Brown to folder to choose excel file, copy sheet(array("source1","source2","source3","source4")
then paste in active workbook with sheetname changed to sheets(array("A","B","C","D").

Thanks in advance./.

 

[Kamolga]

I guess you mean browse to folder with a open browser window and the 4 first sheets of the selected file

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

[COLOR=#008000]'Let user browse for the source file[/COLOR]
 Dim SourceName As Variant
 SourceName = Application.GetOpenFilename

[COLOR=#008000]'Open It[/COLOR]
 Workbooks.Open fileName:=SourceName
 Set SourceWb = ActiveWorkbook

[COLOR=#008000]'Copy Source 1st sheet and Name it "A"[/COLOR]
  SourceWb.Sheets(1).Copy After:=DestWb.Sheets(DestWb.Sheets.Count)
  ActiveSheet.Name = "A"
[COLOR=#008000]'Copy Source 2nd sheet and Name it "B"[/COLOR]
  SourceWb.Sheets(2).Copy After:=DestWb.Sheets(DestWb.Sheets.Count)
  ActiveSheet.Name = "B"
[COLOR=#008000]'Copy Source 3rd sheet and Name it "C"[/COLOR]
  SourceWb.Sheets(3).Copy After:=DestWb.Sheets(DestWb.Sheets.Count)
  ActiveSheet.Name = "C"
[COLOR=#008000]'Copy Source 4th sheet and Name it "D"[/COLOR]
  SourceWb.Sheets(1).Copy After:=DestWb.Sheets(DestWb.Sheets.Count)
  ActiveSheet.Name = "D"

[COLOR=#008000]'Close Source Workbook[/COLOR]
  SourceWb.Close
End Sub

If the sheets are called source1, source 2, ... simply replace

SourceWb.Sheets(1)

by

SourceWb.Sheets("source1")

 

[nhnn1986]

Thanks for yours kind @Kamolga

Code working okey

 

[nhnn1986]

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

[COLOR=#008000]'Let user browse for the source file[/COLOR]
 Dim SourceName As Variant
 SourceName = Application.GetOpenFilename

[COLOR=#008000]'Open It[/COLOR]
 Workbooks.Open fileName:=SourceName
 Set SourceWb = ActiveWorkbook

  SourceWb.Sheets(array("source1","source2","source3","source4").Copy After:=DestWb.Sheets(DestWb.Sheets.Count)
  ActiveSheet.Name = array("A","B","C","D")
[COLOR=#008000]'Close Source Workbook[/COLOR]
  SourceWb.Close
End Sub

I've just change code shorter like above, but this code only copy sheets and paste but don't rename.
Could you have anothe way to fix this code

 

[Kamolga]

THe easiest way is to replace

[COLOR=#333333] ActiveSheet.Name = array("A","B","C","D")[/COLOR]

by one of those macros

   Sub ArraySh()
   Dim oldSh()
    Dim NewSh()
    Dim ws As Worksheet
    Dim numSh As Long
    NewSh = Array("A", "B", "C", "D")
    oldSh = Array("source1", "source2", "source3", "source4")
    On Error Resume Next
    For numSh = LBound(oldSh) To UBound(oldSh)
        Set ws = Nothing
        Set ws = Sheets(oldSh(numSh))
        If Not ws Is Nothing Then ws.Name = NewSh(numSh)
    Next numSh
End Sub

or

Sub ArraySh2()
    Dim ArrSh
    Dim uSh
    Dim shName
    shName = Array("A", "B", "C", "D")
    Set ArrSh = Sheets(Array("source1", "source2", "source3", "source4"))
    For uSh = 1 To ArrSh.Count
        ArrSh(uSh).Name = shName(uSh - 1)
    Next
End Sub

or if you want to keep it short,

call ArraySh

but I hardly see the point of the effort

 

[nhnn1986]

Thanks @Kamolga but could you change code exactly? I'm not sure the place to fill that code to work.