Copy last sheet from multiple close workbooks to a workbook

KlausW

KlausW

Active Member
Joined
Sep 9, 2020
Messages
458
Office Version
  1. 2016
Platform
  1. Windows
Hi, anyone who can help with a VBA code that can copy the last sheet in multiple workbooks that are closed, and insert them after the first two sheets in another workbook.

Any help will be appreciated

Best regards
Klaus W
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Sort by date Sort by votes
I found this code online but can't get it to work. In Range stands is where SourceBook drive, folder name.

Can it help

KW

VBA Code: 
Public Sub CopySheetFromClosedWorkbook()

  Dim sourceBook As Workbook
  Application.ScreenUpdating = False
  
  Set sourceBook = Workbooks.Open.Range("B12")
  sourceBook.Sheets("Optælling").Range("A1:NE14").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  Set sourceBook = Workbooks.Open.Range("B16")
  sourceBook.Sheets("Optælling").Range("A1:NE14").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  Set sourceBook = Workbooks.Open.Range("B20")
  sourceBook.Sheets("Optælling").Range("A1:NE14").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  Set sourceBook = Workbooks.Open.Range("B24")
  sourceBook.Sheets("Optælling").Range("A1:NE14").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  Set sourceBook = Workbooks.Open.Range("B28")
  sourceBook.Sheets("Optælling").Range("A1:NE14").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  Set sourceBook = Workbooks.Open.Range("B32")
  sourceBook.Sheets("Optælling").Range("A1:NE14").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  Set sourceBook = Workbooks.Open.Range("B36")
  sourceBook.Sheets("Optælling").Range("A1:NE14").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  Set sourceBook = Workbooks.Open.Range("B40")
  sourceBook.Sheets("Optælling").Range("A1:NE14").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  Set sourceBook = Workbooks.Open.Range("B44")
  sourceBook.Sheets("Optælling").Range("A1:NE14").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  Set sourceBook = Workbooks.Open.Range("B48")
  sourceBook.Sheets("Optælling").Range("A1:NE14").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  Set sourceBook = Workbooks.Open.Range("B52")
  sourceBook.Sheets("Optælling").Range("A1:NE14").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  Set sourceBook = Workbooks.Open.Range("B56")
  sourceBook.Sheets("Optælling").Range("A1:NE14").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  Set sourceBook = Workbooks.Open.Range("B60")
  sourceBook.Sheets("Optælling").Range("A1:NE14").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  Set sourceBook = Workbooks.Open.Range("B64")
  sourceBook.Sheets("Optælling").Range("A1:NE14").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  Set sourceBook = Workbooks.Open.Range("B68")
  sourceBook.Sheets("Optælling").Range("A1:NE14").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  Set sourceBook = Workbooks.Open.Range("B72")
  sourceBook.Sheets("Optælling").Range("A1:NE14").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  Set sourceBook = Workbooks.Open.Range("B76")
  sourceBook.Sheets("Optælling").Range("A1:NE14").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  Set sourceBook = Workbooks.Open.Range("B80")
  sourceBook.Sheets("Optælling").Range("A1:NE14").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  Set sourceBook = Workbooks.Open.Range("B84")
  sourceBook.Sheets("Optælling").Range("A1:NE14").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  
  'sourceBook.Sheets("Optælling").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  sourceBook.Close
  Application.ScreenUpdating = True
  
End Sub
 
Upvote 0
Try the following and determine if it fits your needs. This macro has not been tested here.

VBA Code: 
Option Explicit

'This code will open each workbook in the specified folder, copy the last sheet, and then
'paste it into the workbook from which you're running the code. It will place the copied
'sheet after the last sheet in your current workbook. Please remember to
'replace "C:\your_path_here\" with the actual path where your workbooks are located.

Sub CopyLastSheetFromWorkbooks()

Dim MyPath As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long
Dim Fnum As Long
Dim mybook As Workbook
Dim basebook As Workbook

    'Fill in the path\folder where the files are
    MyPath = "C:\your_path_here\"
    
    
    'Add a slash at the end if the user forget it
    If Right(MyPath, 1) <> "\" Then
    
        MyPath = MyPath & "\"

    End If


'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xl*")

    If FilesInPath = "" Then
        MsgBox "No files found"
    End If


'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0

    Do While FilesInPath <> ""
    
        Fnum = Fnum + 1
        
        ReDim Preserve MyFiles(1 To Fnum)
        
        MyFiles(Fnum) = FilesInPath
        
        FilesInPath = Dir()
    
    Loop


    'Loop through all files in the array(myFiles)
    If Fnum > 0 Then
            
        For Fnum = LBound(MyFiles) To UBound(MyFiles)
            
            Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
                mybook.Sheets(mybook.Sheets.Count).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            mybook.Close savechanges:=False
        
        Next Fnum
 
        
    End If


End Sub
 
Upvote 0
Solution
Logit said:
Try the following and determine if it fits your needs. This macro has not been tested here.

VBA Code: 
Option Explicit

'This code will open each workbook in the specified folder, copy the last sheet, and then
'paste it into the workbook from which you're running the code. It will place the copied
'sheet after the last sheet in your current workbook. Please remember to
'replace "C:\your_path_here\" with the actual path where your workbooks are located.

Sub CopyLastSheetFromWorkbooks()

Dim MyPath As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long
Dim Fnum As Long
Dim mybook As Workbook
Dim basebook As Workbook

    'Fill in the path\folder where the files are
    MyPath = "C:\your_path_here\"
  
  
    'Add a slash at the end if the user forget it
    If Right(MyPath, 1) <> "\" Then
  
        MyPath = MyPath & "\"

    End If


'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xl*")

    If FilesInPath = "" Then
        MsgBox "No files found"
    End If


'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0

    Do While FilesInPath <> ""
  
        Fnum = Fnum + 1
      
        ReDim Preserve MyFiles(1 To Fnum)
      
        MyFiles(Fnum) = FilesInPath
      
        FilesInPath = Dir()
  
    Loop


    'Loop through all files in the array(myFiles)
    If Fnum > 0 Then
          
        For Fnum = LBound(MyFiles) To UBound(MyFiles)
          
            Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
                mybook.Sheets(mybook.Sheets.Count).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            mybook.Close savechanges:=False
      
        Next Fnum
 
      
    End If


End Sub
Click to expand...
Hi Logit, thank you very much, it works as it should. KW
 
Last edited by a moderator:
Upvote 0
KlausW said:
Hi Logit, thank you very much, it works as it should. KW
Click to expand...
In your future questions, please mark the post as the solution that actually answered your question, instead of your feedback message as it will help future readers. No further action is required for this thread as I have changed the solution mark from post 4 to post 3.

Also, please be careful with what you 'quote'. Quoting the same thing twice simply makes the thread harder to read/navigate and wastes server space. I have removed one of the quotes shown below from post 4

1705271111874.png
 
Upvote 0
Peter_SSs said:
In your future questions, please mark the post as the solution that actually answered your question, instead of your feedback message as it will help future readers. No further action is required for this thread as I have changed the solution mark from post 4 to post 3.

Also, please be careful with what you 'quote'. Quoting the same thing twice simply makes the thread harder to read/navigate and wastes server space. I have removed one of the quotes shown below from post 4

View attachment 105009
Click to expand...
Thanks Peter
 
Upvote 0
You must log in or register to reply here.

Similar threads

KlausW
  • Solved
import a sheet from a closed workbook from location in cell
Replies
3
Views
367
bobsan42
bobsan42
KlausW
  • Solved
copy from a closed Workbook error
Replies
6
Views
475
KlausW
KlausW
KlausW
  • Solved
data without formulas returned
Replies
8
Views
317
Alex Blakenburg
A
KlausW
  • Solved
now() minus 1 month color sheets vba
Replies
9
Views
275
Alex Blakenburg
A
KlausW
  • Solved
Change Attachments from XLSM to XLSX in mail
Replies
5
Views
307
Micron
M

Forum statistics

Threads
1,224,816
Messages
6,181,143
Members
453,021
Latest member
Justyna P

Share this page

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