Copying a range from multiple workbooks to summary workbooks with corresponding worksheets

[jessrabbit]

Hello, I've researched many similar examples but none that I've found meet my needs and my VBA skills aren't good enough to adapt. Please would someone kindly help. I have a folder containing workbooks which I want to copy a specific range of data from one named worksheet and then paste into a newly created worksheet in a summary workbook where the new worksheet is labelled with the source workbook name.

The source data folder contains a variable number of workbooks (probably between 5 and 25) so the new summary workbook would contain a variable number of worksheets.

The source workbook would be named eg. 201905TV21 (year 2019, week 05, manager TV, project 21) and this would become the label for the new worksheet into which the range of data would be copied. This is so that the origin of the data is confirmed in the summary workbook.

Could someone help me to get on the right track with this please?

I've made a start with the code below but;

1. it doesn't copy the data across.
2. I need it to paste the data into separate worksheets in the target workbook. That is;

source workbook 1 data copied to target workbook x worksheet 1
source workbook 2 data copied to target workbook x worksheet 2
source workbook 3 data copied to target workbook x worksheet 3 etc.

Thanks,

Jess

Here's the code I have now;

<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">Option Explicit


Const FOLDER_PATH = "C:\Users\Dashboards (LIVE SOURCE)"


Sub ImportWorksheets()
'=============================================
'Process all Excel files in specified folder
'=============================================
Dim sFile As String 'file to process
Dim wsTarget As Worksheet
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim rowTarget As Long 'output row

rowTarget = 2

'check the folder exists
If Not FileFolderExists(FOLDER_PATH) Then
MsgBox "Specified folder does not exist, exiting!"
Exit Sub
End If

'reset application settings in event of error
On Error GoTo errHandler
Application.ScreenUpdating = False

'set up the target worksheet
Set wsTarget = Sheets("Sheet2")

'loop through the Excel files in the folder
sFile = Dir(FOLDER_PATH & "*.xlsx*")
Do Until sFile = ""

'open the source file and set the source worksheet
Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
Set wsSource = wbSource.Worksheets("Dashboard")

'import the data
With wsTarget
.Range("D2:Z62").Value = wsSource.Range("D2:Z62").Value

End With

'close the source workbook, increment the output row and get the next file
wbSource.Close SaveChanges:=False
rowTarget = rowTarget + 1
sFile = Dir()
Loop

errHandler:
On Error Resume Next
Application.ScreenUpdating = True

'tidy up
Set wsSource = Nothing
Set wbSource = Nothing
Set wsTarget = Nothing
End Sub




Private Function FileFolderExists(strPath As String) As Boolean
If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function</code>

 

[jessrabbit]

Hello, here it is;

Sub Macro2()
'
' Macro2 Macro
'


'
    Range("B2:Z62").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("B1").Select
    ActiveSheet.Pictures.Paste.Select
    ActiveSheet.Shapes.Range(Array("Picture 1")).Select
    ActiveWindow.DisplayGridlines = False
End Sub

Thanks,

Jess

 

[DanteAmor]

Ok, try with this:

Option Explicit


Const FOLDER_PATH = "C:\Users\Dashboards (LIVE SOURCE)\"


Sub ImportWorksheets()
    '=============================================
    'Process all Excel files in specified folder
    '=============================================
    Dim sFile As String 'file to process
    Dim wsTarget As Worksheet
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim rowTarget As Long 'output row
    '
    Dim wbTarget As Workbook
    
    Set wbTarget = ThisWorkbook
    
    'check the folder exists
    If Not FileFolderExists(FOLDER_PATH) Then
        MsgBox "Specified folder does not exist, exiting!"
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    'loop through the Excel files in the folder
    sFile = Dir(FOLDER_PATH & "*.xlsx*")
    Do Until sFile = ""
    
        'open the source file and set the source worksheet
        Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
        Set wsSource = wbSource.Worksheets("Dashboard")
        
        'import the data
        wsSource.Range("B2:Z62").Copy
        wbTarget.Sheets.Add after:=wbTarget.Sheets(wbTarget.Sheets.Count)
        Set wsTarget = wbTarget.ActiveSheet
        wbTarget.Activate
        wsTarget.Select
        ActiveSheet.Pictures.Paste.Select
        ActiveSheet.Shapes.Range(Array("Picture 1")).Select
        ActiveWindow.DisplayGridlines = False
        wsTarget.Name = Replace(sFile, ".xlsx", "")
        
        'close the source workbook, increment the output row and get the next file
        wbSource.Close SaveChanges:=False
        sFile = Dir()
    Loop
    
    Application.ScreenUpdating = True
    'tidy up
    Set wsSource = Nothing
    Set wbSource = Nothing
    Set wbTarget = Nothing
    Set wsTarget = Nothing
End Sub
'
Private Function FileFolderExists(strPath As String) As Boolean
    If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function

 

[jessrabbit]

Absolutely perfect! Thank you so much for your patience and sharing your expertise.

Best wishes,

Jess

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.