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]

Perfect :D

 

[Jeffreyxx01]

Is there any way to make it as a loop,
I try to explain: just repeat the task to copy and paste the data taken from different point and copy it in values in some other point

Sub OpenFile()
   
   Dim Fname As String
   Dim Wbk As Workbook
   Dim Sht As Worksheet
   Dim Usdrws As Long
   
   Set Sht = ActiveWorkbook.Sheets("OTC")
   ChDrive "W:"
   ChDir "W:\Insights Team\ALL ACADEMIC\Reporting\Weekly RAM\OTC\Weekly RAM"
   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("January'18 Summary")
        Sht.Range("m41:q54").ClearContents
        .Range("l5:p18").Copy
        Sht.Range("m41").PasteSpecial xlPasteValues
        
[COLOR=#ff0000]        Wbk.Sheets ("Historical Data")[/COLOR]
[COLOR=#ff0000]        Sht.Range("x29:ah36").ClearContents[/COLOR]
[COLOR=#ff0000]        .Range("h41:r48").Copy[/COLOR]
[COLOR=#ff0000]        Sht.Range("x29").PasteSpecial xlPasteValues[/COLOR]
        
         Application.CutCopyMode = False
      End With
        Application.DisplayAlerts = False
        Wbk.Close , False
        
   End If

 

[Fluff]

Is it one specific range from each sheet?

 

[Jeffreyxx01]

yes there is different range.

 

[Fluff]

What are the sheet names, the ranges to copy from & the ranges to copy to

 

[Jeffreyxx01]

Well I dont know all of these sheets and ranges yet, I am just updating the code time to time on my needs.
If there is a way to loop the code to copy and paste data from different worksheets,
if you can make an example on the first and then I can try amending it?

 

[Fluff]

How about

   Dim Ary As Variant
   Dim Info As String
   Dim Cnt As Long
   
   Info = "January'18 Summary|M41:Q54|Historical Data|X29:AH36"
   Ary = Split(Info, "|")
   For Cnt = LBound(Ary) To UBound(Ary) Step 2
      Worksheets(Ary(Cnt)).Range(Ary(Cnt + 1)).Interior.Color = 104
   Next Cnt

 

[Jeffreyxx01]

Is it the correct way to write it? I do not see how to add this.

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|Historical Data|X29:AH36"
   Ary = Split(Info, "|")
   For Cnt = LBound(Ary) To UBound(Ary) Step 2
      Worksheets(Ary(Cnt)).Range(Ary(Cnt + 1)).Interior.Color = 104
   Next Cnt
   
   Set Sht = ActiveWorkbook.Sheets("OTC")
   ChDrive "W:"
   ChDir "W:\Insights Team\ALL ACADEMIC\Reporting\Weekly RAM\OTC\Weekly RAM"
   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("January'18 Summary")
        Sht.Range("m41:q54").ClearContents
        .Range("l5:p18").Copy
        Sht.Range("m41").PasteSpecial xlPasteValues
        
        Wbk.Sheets ("Historical Data")
        Sht.Range("x29:ah36").ClearContents
        .Range("h41:r48").Copy
        Sht.Range("x29").PasteSpecial xlPasteValues
        
         Application.CutCopyMode = False
      End With
        Application.DisplayAlerts = False
        Wbk.Close , False
        
   End If

 

[Fluff]

Like this

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"
   Ary = Split(Info, "|")

   Set Sht = ActiveWorkbook.Sheets("OTC")
   ChDrive "W:"
   ChDir "W:\Insights Team\ALL ACADEMIC\Reporting\Weekly RAM\OTC\Weekly RAM"
   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

 

[Jeffreyxx01]

Hi

Thanks for the change, there is a problem in the code, it closes my file automatically, hence nothing is actually being done.

Can you see the problem?