Previous Topic Next Topic

Macros for create new excel sheet from active workbook

Closed
yasarakesh Posts 1 Registration date Friday October 4, 2013 Status Member Last seen October 4, 2013 - Oct 4, 2013 at 02:48 AM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Oct 7, 2013 at 12:42 AM
Hi,
could you please provide a logic for create new excel sheet from active workbook, please find the my code below.
Private Sub cmdCFUploadFile_Click()
STR_METHOD_NAME = "cmdCreateFinalSheet_Click"
Dim strPath As String
Dim strCurrPath As String
Dim strPriorPath As String
Dim strCurryear As String
Dim strCurrMonth As String
Dim strPriorMonthFile As String
Dim strCurrentMonthFile As String
Dim strPriorYear As String
Dim strPriorMonth As String
Dim strTempRow As String
'Get the path where the current workbook is located
strPath = Application.ActiveWorkbook.Path
'Get the Current year and month from the Sheet
strCurryear = Trim(ActiveSheet.Range("D16"))
strCurrMonth = Trim(ActiveSheet.Range("E16"))

If MsgBox("Are you sure that you have selected the correct year and month in the year and month cells ?", vbYesNo) = vbYes Then

If strCurrMonth = 1 Then
strPriorYear = strCurryear - 1
strPriorMonth = 12
Else
strPriorMonth = strCurrMonth - 1
strPriorYear = strCurryear
End If
'Get the prior month file path
strPriorPath = strPath & "\CF_Upload_" & strPriorMonth & "_" & strPriorYear & ".xlsx"
'Get the current month file path
strCurrPath = strPath & "\CF_Upload_" & strCurrMonth & "_" & strCurryear & ".xlsx"


'Check If the file with the current month name already exists or not
If bFileExists(strCurrPath) Then
'If the file with current month exists
'Rakesh
If MsgBox("The file for current month already exists. Do you want to rerun it again", vbYesNo) = vbYes Then
If bWorkbookIsOpen("CF_Upload_" & strCurrMonth & "_" & strCurryear & ".xlsx") Then
MsgBox ("The current month file is already open. Please close this file and run it again. ")
Exit Sub
End If
Else
Exit Sub
End If
End If

On Error GoTo ErrorHandler

'Activate the "Final" worksheet to get the no of rows in it.
ThisWorkbook.Worksheets("Final").Select

If Trim(ActiveSheet.Range("A2")) <> "" Then
ActiveSheet.Range("A2").Select
Selection.End(xlDown).Select
strTempRow = Selection.Row
Else
strTempRow = 1
End If
'Call ths method to preserve history
GetPreviousHistory (strTempRow)


Call WriteCFUploadData(strTempRow, strCurryear, strCurrMonth)
ActiveSheet.Range("A2:D" & strTempRow).Select
' Selection.Clear



' strPriorPath = strPath & "\CF_Upload_" & strPriorMonth & "_" & strPriorYear & ".xlsx"
' strCurrPath = strPath & "\CF_Upload_" & strCurrMonth & "_" & strCurryear & ".xlsx"

If bFileExists(strPriorPath) Then
'If the file exists then check whether its open or not
If Not bWorkbookIsOpen("CF_Upload_" & strPriorMonth & "_" & strPriorYear) Then
'If the file is not open then open the file
Workbooks.Open Filename:=strPriorPath, UpdateLinks:=0
Workbooks("CF_Upload_" & strPriorMonth & "_" & strPriorYear & ".xlsx").Activate

If bFileExists(strCurrPath) Then
If MsgBox("There is already a file name" & "\CF_Upload_" & strCurrMonth & "_" & strCurryear & ".xlsx" & _
" at the path " & strPath & " Do you want to overwrite it", vbYesNo) = vbYes Then
'To delete the file with the current name

fobj.DeleteFile strCurrPath, True
Sleep 2000

'Now save the file again
Workbooks("CF_Upload_" & strPriorMonth & "_" & strPriorYear & ".xlsx").Activate
ActiveWorkbook.SaveAs Filename:=strCurrPath, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False

End If

On Error Resume Next

Else
ActiveWorkbook.SaveAs Filename:=strCurrPath, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
On Error Resume Next
End If
Call CopyCFData(strCurrMonth, strCurryear)
Else
Workbooks("CF_Upload_" & strPriorMonth & "_" & strPriorYear & ".xlsx").Activate

If bFileExists(strCurrPath) Then
If MsgBox("There is already a file name" & "\CF_Upload_" & strCurrMonth & "_" & strCurryear & ".xlsx" & _
" at the path " & strPath & " Do you want to override it", vbYesNo) = vbYes Then

fobj.DeleteFile strCurrPath, True
Sleep 2000

'To delete the file with the current name
'Now save the file again
ActiveWorkbook.SaveAs Filename:=strCurrPath, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False

End If

Else
ActiveWorkbook.SaveAs Filename:=strCurrPath, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
End If

Call CopyCFData(strCurrMonth, strCurryear)


End If
Related:

1 response

Answer 1 / 1
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811
Oct 7, 2013 at 12:42 AM
from the code I have to duess what you want to do. what I have guesssed is this
1. there ia an activworkbook
2.there are data for many months(same year or different year) in sheet1
3. you want each month's data to be trsnferred to a new sheet (repeat new sheest and not new workbook)with sheet tab that month and year

is this your problem. confirm

if the workbook is active that mean it is open and why stsrpath?

after separing monthly data into different SHEETS do you want to save it in the same name or different name.

the macro is too long (may be ok) and can be tweaked.

also post a small extrct of your data in sheet1

you can filtere the data with respect to each month data and copy the filtered data to the new sheet of the month(existing or otherwise). this is easier

rethink and give logical steps