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]

Hello Fluff,
Can you please help me on this modification of the macro:

Sub OpenFile()   
   Dim Fname As String
   Dim Wbk As Workbook
   Dim Sht As Worksheet
   Dim LastRow As Long


   
   Set Sht = ActiveWorkbook.Sheets("Pipeline")
   ChDrive "W:"
   ChDir "W:\Insights Team\ALL ACADEMIC\Reporting\Weekly RAM\Pathways\Weekly Tracker"
   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("P-pipeline")
        LastRow = Range("A:S").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
         Sht.Range("A4:LastRow").ClearContents
         .Range("A4:LastRow").Copy Sht.Range("A4")
      End With
        Application.DisplayAlerts = False
   Wbk.Close , False
        Application.DisplayAlerts = True
   End If


End Sub

I want the macro to copy until the last row and to paste the same in the other workbook, but I have a bug on the lastrow formula.

 

[Fluff]

Try

Sub OpenFile()
   Dim Fname As String
   Dim Wbk As Workbook
   Dim Sht As Worksheet
   Dim LastRow As Long


   
   Set Sht = ActiveWorkbook.Sheets("Pipeline")
   ChDrive "W:"
   ChDir "W:\Insights Team\ALL ACADEMIC\Reporting\Weekly RAM\Pathways\Weekly Tracker"
   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("P-pipeline")
        LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
         Sht.Range("A4:S" & LastRow).ClearContents
         .Range("A4:S" & LastRow).Copy Sht.Range("A4")
      End With
        Application.DisplayAlerts = False
   Wbk.Close False
        Application.DisplayAlerts = True
   End If


End Sub

 

[Jeffreyxx01]

Thank you Fluff, works well,
Just some small details that I need to learn. :D

 

[Fluff]

Glad to help & thanks for the feedback.

 

[Jeffreyxx01]

Hi Fluff,

I have a question or request to ask you,

Is there any ways to create a macro that copy and paste 4 different sheets into a single one and slide down the formula automatically (like the one you made), but the thing is I want the macro to copy and paste at the following row by finding the last row in each sheet and pasting into one workbook.
I don't know if it makes sense?

Thanks.

 

[Fluff]

If I've understood you correctly & using the previous code as an example

   With Wbk.Sheets("P-pipeline")
      lastrow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
      .Range("A4:S" & lastrow).Copy Sht.Range("A" & Rows.Count).End(xlUp).Offset(1)
   End With

This will copy the data from sheet & paste to 1 row below the last used cell in col A

 

[Jeffreyxx01]

Well it is a totally new report with the same idea as the one,

I want to copy 4 different worksheets coming from different workbooks each into 1 and slide down the formula on the right-hand side,
So like, the data copied come from A2:S, and all have to find the last row and copy into one and paste at the following.

 

[Fluff]

What code have you got so far?

 

[Jeffreyxx01]

Sub OpenFile()
Dim Fname As String
Dim Wbk As Workbook
Dim Sht As Worksheet
Dim LastRow As Long



Set Sht = ActiveWorkbook.Sheets("Pipeline")
ChDrive "W:"
ChDir "W:\has to be changed"
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("has to be changed")
LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Sht.Range("A4:S" & LastRow)
.Range("A4:S" & LastRow).Copy Sht.Range("A4")
End With
Application.DisplayAlerts = False
Wbk.Close False
Application.DisplayAlerts = True
End If


End Sub

 

[Jeffreyxx01]

I want to adapt the code at the top to select 4 sheets and to paste under each.
using the range to copy at a2:s for each report to be copied and paste under each other starting from A4