VBA loop to export specific sheets from workbook

[p4nny]

Hi

I would like a macro that would select specific sheets based off the tab name using a list on a separate tab, move them to a new workbook and save in a location that i would specify.

Basically, in a one excel sheet I have list of salesman's names and a corresponding tab in the same workbook matching those names.

What I would like is the macro to select a name of Salesman from the list, move it to new workbook along with a tab called raw data... I suppose the rule would be along lines of ... loop until column A in salesman list is blank.

Appreciate your help, Hope this is clear.

Anthony

 

[ParamRay]

.
.

This isn't difficult at all, but need some detail first:

(1) What is the name of the worksheet containing your salesman's names?
(2) What is the address of the range of cells containing your salesman's names?
(3) What is the path of the folder you want to save the new workbooks to?
(4) With what filenames do you want to save the new workbooks (e.g. is it the sheet name)?

 

[p4nny]

many thanks for this.

1) sheet is called TM list
2) range is A1 to A19.... would it be possible to have a "do until blank" function.. that way if new salesman are added it will pick them up.. If not, no problem at all I can adjust the range.
3) the file path is here: \\global.ecolab.corp\europe\UKIE\Resource\Reporting
4) Ideally the name of the tab plus todays date would be great.

Thanks again!!

 

[ParamRay]

Sub CopySheets()

  Const strDESTINATION As String _
    = "\\global.ecolab.corp\europe\UKIE\Resource\Reporting\"
  
  Dim objDataSheet     As Object
  Dim rngSheetNames    As Range
  Dim rngSheetName     As Range
  Dim objCopySheet     As Object
  
  Set objDataSheet = ThisWorkbook.Sheets("raw data")
  
  With ThisWorkbook.Worksheets("TM list")
    Set rngSheetNames = Intersect(.UsedRange, .Columns("A"))
  End With
  
  For Each rngSheetName In rngSheetNames
    On Error Resume Next
    Set objCopySheet = ThisWorkbook.Sheets(rngSheetName.Value)
    On Error GoTo 0
    
    If Not objCopySheet Is Nothing Then
      ThisWorkbook.Sheets(Array(objDataSheet.Name, objCopySheet.Name)).Copy
      Application.DisplayAlerts = False
      ActiveWorkbook.SaveAs strDESTINATION & objCopySheet.Name & Space(1) _
         & Format$(Date, "yyyy-MM-dd") & ".xlsx", xlOpenXMLWorkbook
      Application.DisplayAlerts = True
      ActiveWorkbook.Close
    End If
    
    Set objCopySheet = Nothing
  Next rngSheetName
  
  MsgBox "Finished", vbInformation

End Sub

 

[p4nny]

This works great thanks..

One thing.. It runs quite slow.. How would I copy&paste values only of "raw data" into to the newly create sheet?

Once done, would it be possible to hide the "raw data" sheet?

And also return to "active sheet" cell B13 (tab with Salesman name)

Again, very much appreciated.

 

[p4nny]

Hi gpeacock

Do you think the above would be possible?