VBA Copy & Paste Values of three specific sheets into new file, then save file with variable name

[banneduser123]

So File1 is a macro-enabled file. <br>

It is named "S Form MMDDYY".<br>
It is saved on a network drive in this path: "Reg/Reg Reporting YYYY/MM-YY/In House/Form S"<br>

1. Copy Paste Values of three tabs into a new file. The tabs have static names - "Tab1" "Tab2" "Tab3"
2. Save File into a new location: "Reg/Reg Reporting YYYY/MM-YY/Submission/Form S" <br>
3. Save new file with this name: "Final S Form MMDDYY"<br>

 

[DanteAmor]

I suppose that the YYYY, MM, DD data must be replaced by today's date values.


If the above is correct, try the following:

Sub Copy_three_sheets()
  Dim w2 As Workbook, sh As Worksheet
  Dim a As String, b As String, c As String, wPath As String, wFile As String
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Sheets(Array("Tab1", "Tab2", "Tab3")).Copy
  Set w2 = ActiveWorkbook
  For Each sh In w2.Sheets
    sh.Cells.Copy
    sh.Range("A1").PasteSpecial xlPasteValues
  Next
  a = Format(Date, "yyyy")
  b = Format(Date, "mm-yy")
  c = Format(Date, "mmddyy")
  wPath = "C:\Reg\Reg Reporting " & a & "\" & b & "\Submission\Form S\"
  wFile = "Final S Form " & c & ".xlsx"
  w2.SaveAs wPath & wFile
  w2.Close False
  MsgBox "End"
End Sub

 

[banneduser123]

Hi Dante. Thanks again for the help.
Sorry i didn't mention, the YYYY, MM, DD data will be referencing cell A1 in Tab1. (in that cell, i change the date every month, it currently reads "9/30/19"

 

[DanteAmor]

Hi Dante. Thanks again for the help.
Sorry i didn't mention, the YYYY, MM, DD data will be referencing cell A1 in Tab1. (in that cell, i change the date every month, it currently reads "9/30/19"

Ok, try this

Sub Copy_three_sheets()
  Dim w2 As Workbook, sh As Worksheet[COLOR=#0000ff], wDate as Date[/COLOR]
  Dim a As String, b As String, c As String, wPath As String, wFile As String
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  [COLOR=#0000ff]wDate = sheets("Tab1").Range("A1").Value[/COLOR]
  Sheets(Array("Tab1", "Tab2", "Tab3")).Copy
  Set w2 = ActiveWorkbook
  For Each sh In w2.Sheets
    sh.Cells.Copy
    sh.Range("A1").PasteSpecial xlPasteValues
  Next
  a = Format([COLOR=#0000ff]wDate[/COLOR], "yyyy")
  b = Format([COLOR=#0000ff]wDate[/COLOR], "mm-yy")
  c = Format([COLOR=#0000ff]wDate[/COLOR], "mmddyy")
  wPath = "C:\Reg\Reg Reporting " & a & "\" & b & "\Submission\Form S\"
  wFile = "Final S Form " & c & ".xlsx"
  w2.SaveAs wPath & wFile
  w2.Close False
  MsgBox "End"
End Sub

 

[banneduser123]

need one more edit.
there are a number of tabs that are colored black, that i would also need to be included as one of the tabs that gets carried over into the new file...

are you able to do this?

if it helps, i currently use this code for a separate function (to delete all black tabs)

For Each ws In ThisWorkbook.Worksheets
ws.Activate
If ws.Tab.Color = 0 Then
ws.Delete
End If
Next ws

 

[DanteAmor]

Try this

Sub Copy_three_sheets()
  Dim w2 As Workbook, sh As Worksheet, wDate As Date, hojas() As Variant, n As Long
  Dim a As String, b As String, c As String, wPath As String, wFile As String, wcolor As Variant
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  wDate = Sheets("Tab1").Range("A1").Value
  'Sheets(Array("Tab1", "Tab2", "Tab3")).Copy
  n = 0
  For Each sh In ThisWorkbook.Sheets
    Select Case LCase(sh.Name)
      Case LCase("Tab1"), LCase("Tab2"), LCase("Tab3")
        ReDim Preserve hojas(n)
        hojas(n) = sh.Name
        n = n + 1
      Case Else
        If Not sh.Tab.Color = "False" Then
          If sh.Tab.Color = 0 Then
            ReDim Preserve hojas(n)
            hojas(n) = sh.Name
            n = n + 1
          End If
        End If
    End Select
  Next
  Sheets(hojas).Copy
  Set w2 = ActiveWorkbook
  For Each sh In w2.Sheets
    sh.Cells.Copy
    sh.Range("A1").PasteSpecial xlPasteValues
  Next
  a = Format(wDate, "yyyy")
  b = Format(wDate, "mm-yy")
  c = Format(wDate, "mmddyy")
  wPath = "C:\Reg\Reg Reporting " & a & "\" & b & "\Submission\Form S\"
  wFile = "Final S Form " & c & ".xlsx"
  w2.SaveAs wPath & wFile
  w2.Close False
  MsgBox "End"
End Sub

If the sheets with black color are not copied, change this
If Not sh.Tab.Color = "False" Then
line for this
If Not sh.Tab.Color = False Then