Create workbooks like a particular format

[Michael]

Hi,


I have a spreadsheet for filling student mark details.


And I am using the below code to create the workbooks that I got at here.


'Sub Michael_Create_workbooks()

Dim NoOfFiles As Long, source As Worksheet

Set source = ThisWorkbook.Sheets(1)

For i = 2 To [A65536].End(xlUp).Row

Workbooks.Add (1)

ActiveSheet.[C5] = source.Range("C" & i)

ActiveSheet.[C6] = source.Range("B" & i)

ActiveWorkbook.SaveAs ThisWorkbook.Path & "" & source.Range("A" & i) & ".xls", xlWorkbookNormal

ActiveWorkbook.Close True

Next i

MsgBox "All Files has been created in the same folder"

End Sub'


With this code I wish to copy the current worksheet format and create workbooks like this workbook.


Please find the sample workbook at here:

https://www.dropbox.com/s/q0c6w3nynub732k/Arun.xls


Kindly advise me.


Regards,

Michael

 

[SirJB7]

Hi, Michael!


Here you have two alternatives:


1)

copying range from source book (place before Workbooks.Add(1))

-----

Range("C2:N115").Select

Selection.Copy

-----

pasting range into target book (place before ActiveWorkbook.SaveAs)

-----

Range("C2").Select

ActiveSheet.Paste

-----


2)

copying worksheet from source workbook (place before Workbooks.Add(1))

-----

Sheets("worksheet").Select

Application.CutCopyMode = False

-----

pasting worksheet into target workbook (place before ActiveWorkbook.SaveAs)

-----

ThisWorkbook.Sheets("worksheet").Copy Before:=Activeworkbook.Sheets(1)

Activeworkbook.Sheets("worksheet").Select

Activeworkbook.Sheets("worksheet").Columns(1).Cells.ClearContents

-----


Regards!

 

[Michael]

Hi SirJB7,


Thanks for your kind advice.


I chose 2nd alternative and it works with the below code.

[pre]

Sub Michael_Create_workbooks()
Dim NoOfFiles As Long, source As Worksheet
Set source = ThisWorkbook.Sheets("worksheet")
For i = 2 To [A65536].End(xlUp).Row
Sheets("worksheet").Select
Application.CutCopyMode = False
Workbooks.Add (1)
ActiveSheet.[J7] = source.Range("B" & i)
ActiveSheet.[N7] = source.Range("C" & i)
ThisWorkbook.Sheets("worksheet").Copy Before:=ActiveWorkbook.Sheets(1)
ActiveWorkbook.Sheets("worksheet").Select
ActiveWorkbook.Sheets("worksheet").Columns(1).Cells.ClearContents
ActiveWorkbook.Sheets("worksheet").Columns(2).Cells.ClearContents
ActiveWorkbook.Sheets("worksheet").Columns(3).Cells.ClearContents
' ActiveWorkbook.SaveAs ThisWorkbook.Path & "" & source.Range("A" & i) & ".xlsx", xlWorkbookNormal
ActiveWorkbook.SaveAs ThisWorkbook.Path & "" & source.Range("A" & i)
ActiveWorkbook.Close True
Next i
MsgBox "All Files has been created in the same folder"
End Sub

[/pre]

In addition to that i need to delete the "Sheet1" in newly created files.


Please advice me.


Thanks,

Michael

 

[SirJB7]

Hi, Michael!

Glad you solved it. Thanks for your feedback and for your kind words too. And welcome back whenever needed or wanted.

BTW, could you record a macro by yourself using the built-in macro recorder, that selects the unwanted worksheet and deletes it? And then place the code where it goes, i.e., before the SaveAs.

Regards!

PS: You could resume those 3 similar lines in this one:

ActiveWorkbook.Sheets("worksheet").Columns("A:C").Cells.ClearContents

but why would you be doing so if only column A had data, as per your uploaded file?

 

[Debraj]

Hi Michael,


I have gone through you workbook.. but I believe the below will work same as above without "Sheet1"


Please let us know.. if its working..

[pre]

Sub Michael_Create_workbooks()
Dim NoOfFiles As Long, source As Worksheet
Set source = ThisWorkbook.Sheets("worksheet")
For i = 2 To [A65536].End(xlUp).Row
Sheets("worksheet").Select
ThisWorkbook.Sheets("worksheet").Copy
ActiveSheet.[J7] = source.Range("B" & i)
ActiveSheet.[N7] = source.Range("C" & i)
ActiveWorkbook.Sheets("worksheet").Range("A1,B1,c1").EntireColumn.ClearContents
ActiveWorkbook.SaveAs ThisWorkbook.Path & "" & source.Range("A" & i)
ActiveWorkbook.Close True
Next i
MsgBox "All Files has been created in the same folder"
End Sub

[/pre]

Regards,

Deb