Generate workbook

[Adeel]

Hello All
I have below code which doing below thing
Generating new workbook with count as we desired.
And saving it in 97-2003 format in desired path.
Before generating workbook windows appear for ask sheet name, all thing is going good
I wand little appended in this code that I want to generate another workbook (without any count) with only selective columns and save into same path with CSV format.
In this there will be only 5 columns. CCPortal is the resulted sheet in attached
Sheet name will be “CCPORTAL”
below code also replace Workbook with new if already WB exist please keep same for CSV WB.

SubTest()
ConstSize=190

Dim i AsLong, j AsLong
DimWbAsWorkbook
DimSourceAsRange,HeaderAsRange
Dim strMySheetName AsString
strMySheetName =InputBox("Enter Sheet Name:")
'1st number
Set Header = Range("A1")
Set Source = Range("A2")
'In steps down till last number
Application.DisplayAlerts=False
For i =1ToSource.Offset(Rows.Count-Source.Row).End(xlUp).Row-Source.Row+1StepSize
'New file
Set Wb = Workbooks.Add(xlWBATWorksheet)
'Copythis part
Header.EntireRow.CopyWb.Sheets(1).Range("A1")
Source.Offset(j *Size).Resize(Size).EntireRow.CopyWb.Sheets(1).Range("A2")

If strMySheetName <>""ThenWb.Sheets(1).Name= strMySheetName
'Counter
j = j + 1
'Saveand close
Wb.CheckCompatibility=False
Application.ActiveSheet.Columns.AutoFit
ActiveWorkbook.RemovePersonalInformation=True

Wb.SaveAs"C:\Users\adeel1\Desktop\AA" & j & ".xls", FileFormat:=xlExcel8
Wb.Close
Application.DisplayAlerts = True
Next 
End Sub

Adeel

[大灰狼1976]

Hi Adeel!
Welcome to vbaexpress!
question:
selective columns = columns with colours（fixed) or = columns selected at each time ?
if = columns selected at each time, is there a left-right order?
Sorry for my bad English, I hope you can understand what it means.

[Adeel]

Hi sir, first thnx to helping me
i just highlighted columns for idea that these are columns which i want to copy as new workbook, you can ignore colours.
selective columns means that i only want these 5 columns to be copied into new workbook .CSV.
your second question which i understand, yes it will be in order you can review sample file in my first post which is CCportal file.
Adeel

[大灰狼1976]

Test the following code. (test OK with thisworkbook.path)

Sub Test()
Const Size = 190
Dim i As Long, j As Long
Dim Wb As Workbook
Dim Source As Range, Header As Range
Dim strMySheetName As String
strMySheetName = InputBox("Enter Sheet Name:")
'1st number
Set Header = Range("A1")
Set Source = Range("A2")
'In steps down till last number
Application.DisplayAlerts = False
For i = 1 To Source.Offset(Rows.Count - Source.Row).End(xlUp).Row - Source.Row + 1 'StepSize
  'New file
  Set Wb = Workbooks.Add(xlWBATWorksheet)
  'Copythis part
  Header.EntireRow.Copy Wb.Sheets(1).Range("A1")
  Source.Offset(j * Size).Resize(Size).EntireRow.Copy Wb.Sheets(1).Range("A2")
  If strMySheetName <> "" Then Wb.Sheets(1).Name = strMySheetName
  'Counter
  j = j + 1
  'Save and close
  Wb.CheckCompatibility = False
  Application.ActiveSheet.Columns.AutoFit
  ActiveWorkbook.RemovePersonalInformation = True
  Wb.SaveAs "C:\Users\adeel1\Desktop\AA" & j & ".xls", FileFormat:=xlExcel8
  Wb.Close
Next
Call Copy2Csv
Application.DisplayAlerts = True
End Sub
Sub Copy2Csv()
Dim Wb As Workbook, arr, Ws As Worksheet, r&, j&
Set Wb = Workbooks.Add(xlWBATWorksheet)
Set Ws = Wb.Sheets(1)
arr = Array(15, 12, 14, 5)
r = ThisWorkbook.Sheets("CONT").[a65536].End(3).Row
With Ws
  .[a1:e1] = Array("REGION", "MSISDN", "CUSTID", "KAMID", "COMPANYNAME")
  For j = 0 To 3
    ThisWorkbook.Sheets("CONT").Cells(2, arr(j)).Resize(r - 1).Copy .Cells(2, j + 2)
  Next j
  .Cells(2, 1).Resize(r - 1) = "CENTRAL-1"
End With
Wb.SaveAs "C:\Users\adeel1\Desktop\CCPORTAL", xlCSV
Wb.Close False
End Sub

[Adeel]

hi sir
there is some issues, when i run my first code its continuous creating the sheets now,(i have to press ESC to stop it)
second code works good as i need, but i want combine both codes with one click, please look

Adeel

[大灰狼1976]

one click is ok, Please look at the following code

Call Copy2Csv
Application.DisplayAlerts = True
End Sub

[大灰狼1976]

You can also put "Call Copy2Csv" anywhere you want.(Don't put it between For...Next)
and must put it between "Application.DisplayAlerts = False" and "Application.DisplayAlerts = True".

[Adeel]

Hi sir
i didn't make any change in code, just copy and paste your code and run, its contentious generating sheets.

i attached sample workbook again please run the code and see which i meant ..!please

Adeel

[大灰狼1976]

I really don't understand what you mean.
"its contentious generating sheets" is the original code's result, and i only added "Call Copy2Csv".
if you want to generating csv file first, test the code below.

Sub Test()
Const Size = 190
Dim i As Long, j As Long
Dim Wb As Workbook
Dim Source As Range, Header As Range
Dim strMySheetName As String
strMySheetName = InputBox("Enter Sheet Name:")
'1st number
Set Header = Range("A1")
Set Source = Range("A2")
'In steps down till last number
Application.DisplayAlerts = False
Call Copy2Csv
For i = 1 To Source.Offset(Rows.Count - Source.Row).End(xlUp).Row - Source.Row + 1 'StepSize
  'New file
  Set Wb = Workbooks.Add(xlWBATWorksheet)
  'Copythis part
  Header.EntireRow.Copy Wb.Sheets(1).Range("A1")
  Source.Offset(j * Size).Resize(Size).EntireRow.Copy Wb.Sheets(1).Range("A2")
  If strMySheetName <> "" Then Wb.Sheets(1).Name = strMySheetName
  'Counter
  j = j + 1
  'Save and close
  Wb.CheckCompatibility = False
  Application.ActiveSheet.Columns.AutoFit
  ActiveWorkbook.RemovePersonalInformation = True
  Wb.SaveAs "C:\Users\adeel1\Desktop\BB\" & j & ".xls", FileFormat:=xlExcel8
  'Wb.SaveAs ThisWorkbook.Path & "\" & j & ".xls", FileFormat:=xlExcel8
  Wb.Close
Next
Application.DisplayAlerts = True
End Sub
Sub Copy2Csv()
Dim Wb As Workbook, arr, Ws As Worksheet, r&, j&
Set Wb = Workbooks.Add(xlWBATWorksheet)
Set Ws = Wb.Sheets(1)
arr = Array(15, 12, 14, 5)
r = ThisWorkbook.Sheets("CONT").[a65536].End(3).Row
With Ws
  .[a1:e1] = Array("REGION", "MSISDN", "CUSTID", "KAMID", "COMPANYNAME")
  For j = 0 To 3
    ThisWorkbook.Sheets("CONT").Cells(2, arr(j)).Resize(r - 1).Copy .Cells(2, j + 2)
  Next j
  .Cells(2, 1).Resize(r - 1) = "CENTRAL-1"
End With
Wb.SaveAs "C:\Users\adeel1\Desktop\BB\CCPORTAL", xlCSV
Wb.Close False
End Sub

[Adeel]

Hi sir
sorry may there was mistake from my side, in my first code something was missed, i copied again it from original sheet than paste your code now its working like charm, you are brilliant sir thank you vary much for your help and time.

Adeel

[大灰狼1976]

You're welcome