Copy one worksheet to another from different workbook

Jeffreyxx01

Board Regular
Joined
Oct 23, 2017
Messages
156
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.
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
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

Code:
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
 
Upvote 0
Is it one specific range from each sheet?
 
Upvote 0
What are the sheet names, the ranges to copy from & the ranges to copy to
 
Upvote 0
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?
 
Upvote 0
How about
Code:
   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
 
Upvote 0
Is it the correct way to write it? I do not see how to add this.

Code:
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
 
Upvote 0
Like this
Code:
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
 
Upvote 0
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?
 
Upvote 0

Forum statistics

Threads
1,224,827
Messages
6,181,197
Members
453,021
Latest member
pingpong7117

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top