Combine my Macros not going well.

[CreativeUsername]

I need to cycle through the tabs in an open workbook using their names to open corresponding workbooks (see working code below) and copy data to those tabs. I also need it FIRST to check that the last tab is titled with the current month year. I have two sets of working code but am having a bugger of a time combining them.


I thought about putting the sheet creator in the destination folder set to run on open but the "enable editing"stops it. Then id start my transfer syntax with code that would open and close all workbooks in the file (allowing the tab creator to work) THEN run my data transfer...


Honestly its cleaner to integrate the two.

Tab creator (works when run in its own workbook):
Private Sub Autpen() ' Date Tab Creation hapens auto on file open
Dim TabName As String
Dim vntToday As Variant
vntToday = TabName

TabName = Format(Date, "mmm-yyyy") 'Change the format as per your requirement
On Error GoTo AddNew
Sheets(TabName).Activate
Exit Sub
AddNew:
Sheets.Add , Worksheets(Worksheets.Count)
ActiveSheet.Name = TabName

ActiveSheet.Previous.Range("A1:AJ4").Copy Destination:=Range("A1")
ActiveSheet.Previous.Range("AL1:AN500").Copy Destination:=Range("AK1")


End Sub

Data Transfer code (works perfectly but needs to be modified to accommodate a password):

Sub UpdatebyLoop_2()
'Define variables
Application.ScreenUpdating = False
Dim SourceWB As Workbook, destinationWB As Workbook
'Dim ws As Worksheet

'Data Transfer Section
Set SourceWB = ThisWorkbook
On Error GoTo errHandler
For Each ws In SourceWB.Worksheets
If ws.Name <> "Change Control" And ws.Name <> "Archive" Then
Set destinationWB = Workbooks.Open(SourceWB.Path & "" & ws.Name & ".xlsx")
ws.Range("A3:AJ30").Copy Destination:=destinationWB.Sheets(Sheets.Count). _
Cells(destinationWB.Sheets(Sheets.Count).Cells(Rows.Count, 2).End(xlUp).Row + 1, 2)
destinationWB.Close savechanges:=True

End If
'Repeat on next worksheet
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

I've been tinkering with this for hours... any help would be appreciated. What I really want is for the tab creator to work right after the workbook is opened. I notice the transfer code doesn't actually activate the destination sheet. It is ok if the Tab Creator dosen't need to activate the sheets.

In the end all I need is for the data transfer to make sure that the last tab is a match to the current month and if it dosen't create it, copying the header an calc format from the previous sheet.

The Tab creater could even be a separate step/cycle that I'd use in a different macro that calls the ones I need in sequence but for some reason the workbook open part dosent seem to want to work with out the rest of its segment.

Gah....

 

[CreativeUsername]

I think I want a separate macro to just open the workbooks and run the test/create tabs. Then I'll call it in sequence with the others in a grand macro.
Trying it that way I get a 1004 error on the workbooks.Open line saying "Skip Me" could not be found.... but I just said don't look for that one.
Sub TabsCreateCheck()
Dim TabName As String
Dim destinationWB As Workbook, SourceWB As Workbook
Dim ws As Worksheet
Set SourceWB = ThisWorkbook
TabName = Format(Date, "mmm-yyyy") 'Change the format as per your requirement
'Application.ScreenUpdating = False
For Each ws In SourceWB.Worksheets
If ws.Name <> "Skip Me" And ws.Name <> "Skip Me Too" Then
Workbooks.Open (SourceWB.Path & "" & ws.Name & ".xlsx")

End If
On Error GoTo AddNew
Sheets(TabName).Activate
Exit Sub
Next ws
AddNew:
Sheets.Add , Worksheets(Worksheets.Count)
ActiveSheet.Name = TabName

ActiveSheet.Previous.Range("A1:AJ4").Copy Destination:=Range("A1")
ActiveSheet.Previous.Range("AL1:AN500").Copy Destination:=Range("AK1")
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
Exit Sub
End Sub

 

[Veritan]

This thread is a continuation of another started here. This seems to be a fairly specific and detailed scenario, with a lot of places where something could be causing the code to not work properly. One recommendation I have is to look through this series of videos from Wise Owl on YouTube (link is to the first video in the series). You obviously have experience coding in VBA, so you can skip the first several videos, but I'd look through the playlist and see if something in there can help you out. If you can narrow down your question, it's easier to help. Please also wrap any VBA code provide in code tags (use the # symbol on the toolbar). This makes it a lot easier to read the code.

 

[CreativeUsername]

It is a continuation of that project but a separate macro. I will call them in sequence in a macro that compiles them all for simplicity sake. I posted it separately for a few reasons partly to do with making searchable and concise to the issue. I've gotten this far with it and its trying to work and loop BUT I get either little fatal errors in areas that I know are correct in other versions that work out of loop OR it does things it shouldn't, like creating the current month tab anyway AND creating it in SourceWB


[CODESub TabsCreateCheck()
Dim TabName As String
Dim destinationWB As Workbook, SourceWB As Workbook
Dim ws As Worksheet
Set SourceWB = ThisWorkbook
TabName = Format(Date, "mmm yy") 'Change the format as per your requirement
'Application.ScreenUpdating = False
For Each ws In SourceWB.Worksheets
If ws.Name <> "Skip Me" And ws.Name <> "Skip Me2" Then
Workbooks.Open(SourceWB.Path & "" & ws.Name & ".xlsx").Activate
End If



On Error GoTo AddNew
Sheets(TabName).Activate 'if there isn't a tab with the current date Error ... Make One.
Sheets(TabName).Close SaveChanges:=False



AddNew:
Sheets.Add , Worksheets(Worksheets.Count)
ActiveSheet.Name = TabName

ActiveSheet.Previous.Range("A1:AJ4").Copy Destination:=Range("A1")
ActiveSheet.Previous.Range("AL1:AN500").Copy Destination:=Range("AK1")
ActiveWorkbook.Close SaveChanges:=True '<------new

SourceWB.Activate
Next ws

With Application
.CutCopyMode = False
.ScreenUpdating = True
End With

Exit Sub][/CODE]