VBA to open other workbooks based on tab names

CreativeUsername

Board Regular
Joined
Mar 11, 2017
Messages
52
I've been scouring the web and not finding what I need. Also "Excel 2013 Power Programming with VBA" hasn't been able to show me what I need. The code below Is intended to copy data from a range on all tabs except the first one "Skip Me" and paste it into other workbooks. The tabs in "master" correspond to workbooks in the same folder as "Master". So Tabs are : "Alex, Bill, and Sue". Workbooks are "Processor Alex", Processor Bill, Processor Sue. . .Etc. I'm not married to those names in particular. Tabs could include Processor or Processor could be dropped from the file names.

I'm struggling with the part where it finds and opens another workbook. I think i'm really close. I works perfectly if I give it the exact file name but then there is no need for a loop and this is just a test sample. The real project has 12 workbooks and Processors may change so hard coding destinations is cumbersome. The loop works with in the same workbook. So how to make it work, I'm Stumped.

Code:
Sub UpdatebyLoop()


Dim ws As Worksheet
Dim SourceWB As Workbook


Set SourceWB = ThisWorkbook
Application.ScreenUpdating = False


For Each ws In Worksheets
    If ws.Name <> "Skip Me" Then
                  'Debug.Print ws.Name
        ws.Activate
        ws.Select
        Range("A2:M10").Select
        Selection.Copy
        


Workbooks.Open ("C:\Users\Scott\Desktop\VBA Proj\Processor [U][B]" & ws.Name & ".xlsx"[/B][/U]) [COLOR=#ff0000]<----This part gives a "1004" error[/COLOR]
    
    Worksheets(Worksheets.Count).Select 'Selects last worksheet page
    
'Selects destination looking for first blank cell in "B"
        'Set ws = ActiveSheet
        For Each Cell In ws.Columns(2).Cells
            If IsEmpty(Cell) = True Then Cell.Select: Exit For
            Next Cell
                              
        ActiveSheet.Paste 'Pastes selection
        
    Application.CutCopyMode = False 'Clears Clipboard for next copy action
  
    End If


Next ws


End Sub [code]
 
Wait . . .it isn't looping. It only does one tab no matter where I put it that tab in the sequence. That tab was giving me an error that the file could not be found so I renamed it that same and renamed the tab the same... it works now only for that one ? ?

I did the same for the other two and It didn't have the same effect.
 
Upvote 0

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Wroks perfectly on my work computer. Must be an issue with my home computer.

I do need to modify it to copy the same data to a tab named "archive". And make the corresponding A cell the current date and the corresponding B cell the Worksheet name.

After this project I'm looking for an actual VBA course to start.

Any help with that modification would be great.
 
Upvote 0
Wroks perfectly on my work computer. Must be an issue with my home computer.

Happy to hear it works on your work computer.

I do need to modify it to copy the same data to a tab named "archive". And make the corresponding A cell the current date and the corresponding B cell the Worksheet name.

If I understood your request, you might try adding the code in red...

Code:
Sub UpdatebyLoop()
Application.ScreenUpdating = False
Dim SourceWB As Workbook, destinationWB As Workbook
Dim ws As Worksheet
Dim LastRow As Long

Set SourceWB = ThisWorkbook
On Error GoTo errHandler
For Each ws In SourceWB.Worksheets
    [COLOR=#ff0000]If ws.Name <> "Skip Me" And ws.Name <> "archive" Then[/COLOR]
        Set destinationWB = Workbooks.Open(SourceWB.Path & ws.Name & ".xlsx")
        ws.Range("A2:M10").Copy Destination:=destinationWB.Sheets(Sheets.Count). _
            Cells(destinationWB.Sheets(Sheets.Count).Cells(Rows.Count, 2).End(xlUp).Row + 1, 2)
        destinationWB.Close savechanges:=True
        [COLOR=#ff0000]SourceWB.Sheets("archive"). _
            Cells(SourceWB.Sheets(archive).Cells(Rows.Count, 3).End(xlUp).Row + 1, 1).Value = Date
        SourceWB.Sheets("archive"). _
            Cells(SourceWB.Sheets(archive).Cells(Rows.Count, 3).End(xlUp).Row + 1, 2).Value = ws.Name
        ws.Range("A2:M10").Copy Destination:=SourceWB.Sheets("archive"). _
            Cells(SourceWB.Sheets(archive).Cells(Rows.Count, 3).End(xlUp).Row + 1, 3)[/COLOR]
    End If
Next ws
With Application
    .CutCopyMode = False
    .ScreenUpdating = True
End With
Exit Sub

errHandler:
    MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
    "Sorry, it seems the worksheet name - " & ws.Name & " - does not match a workbook name."
    Resume Next
End Sub

Since the date is in Column A and the worksheet name in Column B, the data pastes into Column C (which is different than on the destination workbooks, which pastes into Column B.)

After this project I'm looking for an actual <acronym title="visual basic for applications">VBA</acronym> course to start.

Good luck!!
 
Last edited:
Upvote 0

Forum statistics

Threads
1,215,069
Messages
6,122,954
Members
449,095
Latest member
nmaske

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