Copy one worksheet to another from different workbook

[Jeffreyxx01]

Hi guys,

Can someone help me to write a code that copy one worksheet from one workbook to another worksheet in another workbook.
I need to automate a few tasks at work and I cannot make complex macro.

Thanks for your support.

 

[Jeffreyxx01]

Actually it is fine, I had the other file opened.

 

[Jeffreyxx01]

Hi Fluff, why does the code paste as values does not work?

Sub OpenFile()   
   Dim Fname As String
   Dim Wbk As Workbook
   Dim Sht As Worksheet
   
   Set Sht = ActiveWorkbook.Sheets("PW")
   ChDrive "W:"
   ChDir "W:\Insights Team\ALL ACADEMIC\Reporting\Weekly RAM\Pathways"
   Fname = Application.GetOpenFilename(FileFilter:="xls Files (*.xls*), *.xls*", Title:="Select a file", MultiSelect:=False)
   If Fname = "False" Then
      MsgBox "no file selected"
      Exit Sub
   Else
      Set Wbk = Workbooks.Open(Fname)
      With Wbk.Sheets("Summary for BP")
         Sht.Range("s6:W27").ClearContents
         .Range("i7:M28").Copy Sht.Range("s6")
         .PasteSpecial _
         Paste:=xlValues
         
Application.CutCopyMode = False
      End With
 Application.DisplayAlerts = False
      Wbk.Close , False
   End If


End Sub

 

[Fluff]

Look at how you had it in post#48

 

[Jeffreyxx01]

Yes I corrected it and it works fine, just a small change make it bad, coding is fun.

 

[Jeffreyxx01]

Hi Fluff,

Is it possible to have a code that looks the same as post #48 but like one file that feeds 20 tabs in another?

Sub OpenFile()   Dim Fname As String
   Dim Wbk As Workbook
   Dim Sht As Worksheet
   Dim Usdrws As Long
   Dim Ary As Variant
   Dim Info As String
   Dim Cnt As Long
   
   Info = "January'18 Summary|M41:Q54|L5:P18|Historical Data|X29:AH36|H41:R48|Historical Data|X44:AE51|H23:O30"
   Ary = Split(Info, "|")


   Set Sht = ActiveWorkbook.Sheets("NAME")
   ChDrive "W:"
   ChDir "W:\Insights Team\ALL GROUP\KPI"
   Fname = Application.GetOpenFilename(FileFilter:="xls Files (*.xls*), *.xls*", Title:="Select a file", MultiSelect:=False)
   If Fname = "False" Then
      MsgBox "no file selected"
      Exit Sub
   Else
      Set Wbk = Workbooks.Open(Fname)
      For Cnt = LBound(Ary) To UBound(Ary) Step 3
         With Sht.Range(Ary(Cnt + 1))
            .ClearContents
            .Value = Worksheets(Ary(Cnt)).Range(Ary(Cnt + 2)).Value
         End With
      Next Cnt
      Application.DisplayAlerts = False
      Wbk.Close , False
      Application.DisplayAlerts = True
   End If
   
End Sub

 

[Jeffreyxx01]

I forgot to mention,

For example, I have one sheet called OTC with range a1:z100 to be paste as values to OTC range a1:z100 in another workbook on the tab called OTC
Then I have another called XYZ with range a1:z100 to go to XYZ same range,
But everything that goes to the second workbook come from the same workbook.

I just need that because I have linked the second workbook to some work.

If you see what I mean, that would be great

 

[Fluff]

Not sure if I've understood correctly, but if all the ranges are the same try

Sub OpenFileCopy()
   Dim Fname As String
   Dim SrcWbk As Workbook
   Dim DestWbk As Workbook
   Dim Usdrws As Long
   Dim Ary As Variant
   Dim Cnt As Long
   
   Ary = Array("[COLOR=#ff0000]MA[/COLOR]", "[COLOR=#ff0000]Pick[/COLOR]", "[COLOR=#ff0000]Test[/COLOR]", "[COLOR=#ff0000]Sheet1[/COLOR]")

   Set DestWbk = ThisWorkbook
   ChDrive "W:"
   ChDir "W:\Insights Team\ALL GROUP\KPI"
   Fname = Application.GetOpenFilename(FileFilter:="xls Files (*.xls*), *.xls*", title:="Select a file", MultiSelect:=False)
   If Fname = "False" Then
      MsgBox "no file selected"
      Exit Sub
   Else
      Set SrcWbk = Workbooks.Open(Fname)
      For Cnt = LBound(Ary) To UBound(Ary)
         DestWbk.Sheets(Ary(Cnt)).Range("A1:Z100").Value = _
            SrcWbk.Sheets(Ary(Cnt)).Range("A1:Z100").Value
      Next Cnt
      Application.DisplayAlerts = False
      Wbk.Close , False
      Application.DisplayAlerts = True
   End If
   
End Sub

Change the values in red to match your sheet names

 

[Jeffreyxx01]

Thanks, I will try it and let you know if there is any problem.

 

[Jeffreyxx01]

Hi Fluff,

it works very well, there is no problem.

THANK YOU

 

[Fluff]

Glad to help & thanks for the feedback