VBA loop copy & paste range to same worksheet name of another workbook n.2

[AriannaVV]

I found here the code below which does exactly what I need and that is loop through sheets of a source workbook, copy a range of data and paste to another workbook where sheets have the same name of the source wb. Works perfectly until it comes to different named sheets where I get an error message "out of range". How can I skip this? Furthermore there are two sheets (TOTALS & GENERAL) that I want the code to skip them and run only through all other sheets. Thank you in advance for your kind help.

Sub Button1_Click()

    Dim SourceWb As Workbook, DestWb As Workbook
    Dim SourceWs As Worksheet, DestWs As Worksheet
    Dim WsName As String
    Dim CopyRng As Range


    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
   
    Set SourceWb = ThisWorkbook
    'Set SourceWs = SourceWb.Worksheets
   
    Set DestWb = Workbooks.Open("C:\Users\Juanna\Desktop\downloads\master.xlsx", , True) 'Readonly = True
   
    'Loop through all worksheets and copy the data to the DestWs
    For Each SourceWs In SourceWb.Worksheets
   
        'Fill in the range that you want to copy
        Set CopyRng = SourceWs.Range("b1:c10")
       
        Set DestWs = DestWb.Worksheets(SourceWs.Name)
       
        With CopyRng
        DestWs.Cells(Last + 1, "b").Resize(.Rows.Count, .Columns.Count).Value = .Value
        End With
Next
ExitTheSub:
    Application.Goto DestWs.Cells(1)
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

 

[dmt32]

Hi,
untested but see if this update to your code does what you want

Sub Button1_Click()
    
    Dim SourceWb    As Workbook, DestWb As Workbook
    Dim SourceWs    As Worksheet, DestWs As Worksheet
    Dim WsName      As String
    Dim CopyRng     As Range
    
    '-----------------------------------------------------------------------------------------------------------------------------------
    '                                                               SETTINGS
    '-----------------------------------------------------------------------------------------------------------------------------------
    'destination filepath & filename
    Const strFileName = "C:\Users\Juanna\Desktop\downloads\master.xlsx"
    
    'sheets to ignore
    IgnoreSheets = Array("TOTALS", "GENERAL")
    
    '-----------------------------------------------------------------------------------------------------------------------------------
    
    On Error GoTo ExitTheSub
    With Application
        .ScreenUpdating = False: .EnableEvents = False
    End With
    
    Set SourceWb = ThisWorkbook
    'Set SourceWs = SourceWb.Worksheets
    
    Set DestWb = Workbooks.Open(strFileName, , True)        'Readonly = True
    
    'Loop through all worksheets and copy the data to the DestWs
    For Each SourceWs In SourceWb.Worksheets
        If IsError(Application.Match(SourceWs.Name, IgnoreSheets, 0)) Then
            'Fill in the range that you want to copy
            Set CopyRng = SourceWs.Range("b1:c10")
            
            Set DestWs = DestWb.Worksheets(SourceWs.Name)
            
            With CopyRng
                DestWs.Cells(1, "b").Resize(.Rows.Count, .Columns.Count).Value = .Value
            End With
        End If
        
nextsheet:
        Set DestWs = Nothing
        Set CopyRng = Nothing
    Next
    
ExitTheSub:
    If Err <> 0 Then
        If Err.Number = 9 Then Resume nextsheet
        MsgBox (Error(Err)), 48, "Error"
    End If
    
    With Application
        .ScreenUpdating = True: .EnableEvents = True
    End With
End Sub

Dave

 

[AriannaVV]

Hi,
untested but see if this update to your code does what you want

Sub Button1_Click()
   
    Dim SourceWb    As Workbook, DestWb As Workbook
    Dim SourceWs    As Worksheet, DestWs As Worksheet
    Dim WsName      As String
    Dim CopyRng     As Range
   
    '-----------------------------------------------------------------------------------------------------------------------------------
    '                                                               SETTINGS
    '-----------------------------------------------------------------------------------------------------------------------------------
    'destination filepath & filename
    Const strFileName = "C:\Users\Juanna\Desktop\downloads\master.xlsx"
   
    'sheets to ignore
    IgnoreSheets = Array("TOTALS", "GENERAL")
   
    '-----------------------------------------------------------------------------------------------------------------------------------
   
    On Error GoTo ExitTheSub
    With Application
        .ScreenUpdating = False: .EnableEvents = False
    End With
   
    Set SourceWb = ThisWorkbook
    'Set SourceWs = SourceWb.Worksheets
   
    Set DestWb = Workbooks.Open(strFileName, , True)        'Readonly = True
   
    'Loop through all worksheets and copy the data to the DestWs
    For Each SourceWs In SourceWb.Worksheets
        If IsError(Application.Match(SourceWs.Name, IgnoreSheets, 0)) Then
            'Fill in the range that you want to copy
            Set CopyRng = SourceWs.Range("b1:c10")
           
            Set DestWs = DestWb.Worksheets(SourceWs.Name)
           
            With CopyRng
                DestWs.Cells(1, "b").Resize(.Rows.Count, .Columns.Count).Value = .Value
            End With
        End If
       
nextsheet:
        Set DestWs = Nothing
        Set CopyRng = Nothing
    Next
   
ExitTheSub:
    If Err <> 0 Then
        If Err.Number = 9 Then Resume nextsheet
        MsgBox (Error(Err)), 48, "Error"
    End If
   
    With Application
        .ScreenUpdating = True: .EnableEvents = True
    End With
End Sub

Dave

Works great!!! Thank you very much!!

 

[dmt32]

Works great!!! Thank you very much!!

most welcome & appreciate your feedback

Dave

 

[AriannaVV]

Although the code above runs perfectly I need something more. Can you please advice on how to change it so I can select the range through a message box? Thank you in advance for any help provided.

 

[Kristylee0228]

Hi.. I am curious if this code is able to be modified to select a date range? I have a workbook with tabs dated that need to be copied and paste into a different sheet.
Having a date range would work perfect so that each week, we only select new dates as applicable to the week we need.
Any help would be greatly appreciated.