Trying to get all sheet names in excel workbook and then give those names to new excel sheet and save it as csv

[shayanhaque]

Hi,

I'm trying to copy column one of each sheet and save it to new sheet which will then be saved as csv file and name of new sheet should be pulled from old workbook.

if sheet names are If ShtNames(i) = "Sheet1" Or "Error log" Or "JUMPER REPORT" Or "WIRE LABELS" Or "TERMINATION COUNT" Then it should go to next worksheet else it should run the remaining program.

Please help me in this regard.

Sub wires()
   Dim Ary As Variant
   Dim NewBk As Workbook
   Dim ws As Worksheet
   Dim test As String
   Dim ShtNames() As String
ReDim ShtNames(1 To ActiveWorkbook.Sheets.Count)
For i = 1 To Sheets.Count
ShtNames(i) = Sheets(i).Name
Next i
   For Each ws In ThisWorkbook.Worksheets
ws.Activate
   If ShtNames(i) = "Sheet1" Or "Error log" Or "JUMPER REPORT" Or "WIRE LABELS" Or "TERMINATION COUNT" Then
   ActiveSheet.Next.Select
   
   
   Else
      
   Ary = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value2
   Range("V1").Resize(UBound(Ary)).Value = Ary
   Set NewBk = Workbooks.Add
   NewBk.Sheets(1).Range("A1").Resize(UBound(Ary)).Value = Ary
   NewBk.SaveAs Filename:="C:\Path" & test & ".csv", FileFormat:=xlCSV, CreateBackup:=False
    
   'NewBk.SaveAs Filename:="C:\Users\Documents\test_files" mySheet & " .csv", FileFormat:=xlCSV, CreateBackup:=False
   
   Set Ary = Nothing
   Set NewBk = Nothing
   End If
   
   Next ws


   
   
   
   
End Sub

 

[Fluff]

How about

Sub shayanhaque()
   Dim Ary As Variant
   Dim NewBk As Workbook
   Dim ws As Worksheet
   Dim Pth As String
   
   Pth = Environ("userprofile")
   For Each ws In ThisWorkbook.Worksheets
      Select Case ws.Name
         Case "Sheet1", "Error log", "JUMPER REPORT", "WIRE LABELS", "TERMINATION COUNT"
         Case Else
            Ary = ws.Range("A1", ws.Range("A" & Rows.Count).End(xlUp)).Value2
            ws.Range("V1").Resize(UBound(Ary)).Value = Ary
            Set NewBk = Workbooks.Add
            NewBk.Sheets(1).Range("A1").Resize(UBound(Ary)).Value = Ary
            NewBk.SaveAs FileName:=Pth & "\" & ws.Name & ".csv", FileFormat:=xlCSV
            
            NewBk.Close False
            Set Ary = Nothing
            Set NewBk = Nothing
      End Select
   Next ws
End Sub

 

[shayanhaque]

it works perfectly. Thank you. One more question:

If i want to save each file to use defined place, how can i do that?

 

[Fluff]

How do you want the user to select the folder/path?
A pop-up box? or enter the value in a cell?

 

[shayanhaque]

A pop-up box which let user select folder where they want to save each file.

 

[shayanhaque]

in additon, how can i make this program to run as add in please?

Thank you for all your help

 

[Fluff]

How about

Sub shayanhaque()
   Dim Ary As Variant
   Dim NewBk As Workbook
   Dim ws As Worksheet
   Dim Pth As String
   
   With Application.fileDialog(4)
      If .Show = -1 Then Pth = .SelectedItems(1)
   End With
   For Each ws In ThisWorkbook.Worksheets
      Select Case ws.Name
         Case "Sheet1", "Error log", "JUMPER REPORT", "WIRE LABELS", "TERMINATION COUNT"
         Case Else
            Ary = ws.Range("A1", ws.Range("A" & Rows.Count).End(xlUp)).Value2
            ws.Range("V1").Resize(UBound(Ary)).Value = Ary
            Set NewBk = Workbooks.Add
            NewBk.Sheets(1).Range("A1").Resize(UBound(Ary)).Value = Ary
            NewBk.SaveAs FileName:=Pth & "\" & ws.Name & ".csv", FileFormat:=xlCSV
            
            NewBk.Close False
            Set Ary = Nothing
            Set NewBk = Nothing
      End Select
   Next ws
End Sub

 

[shayanhaque]

works perfectly. Thank you. Now, How can i transform this into addin? please

 

[Fluff]

Have a look here https://trumpexcel.com/excel-add-in/
If you still have problems, then you will need to start a new thread.