Hy guys/girls,
I'm working on a order sheet for my cook at my school to make is life easyer, it a surprise.
I already got some macro that i'm taking from other part of project to make this one happen.
My macro copy my sheet, next to sheet 2, to never scrap my orignal sheet.
On my copy sheet i want to delete unused row if no quantity in a specific cell, but skiping all the header, like this my sheet will be shorter.
But i'm stuck on that part. I'm pretty sure one of you will find a way to do it.
I'm using A to J to 680.
I got all my title, and info for the order from row 1 to 11, i don't want to touch. I never pass J column.
All start here, i got line 12 and 13 is a header, line 14 to 48 i want to delete row if nothing in C cell on that row.
Then stop for next header line 49 and 50. And deleting row form line 51 to 70 if nothing is found in C cell
Then stop for next header line 71 and 72. And deleting row form line 73 to 103 if nothing is found in C cell
Then stop for next header line 104 and 105. and again and again till last line a 680. (if we need it i can give you all the line for those header or look at the end all the line i want to ''delete'' are there)
after that my macro can transfert it to pdf and attach it on an e-mail then ship it, then erase the copy sheet, and erase all c cell in the original sheet.
I hope you can help me Thanks in advance
Here what i got from now :
Sub Automationdubort()
Sheets("Dubort Et Rainville").Select
ActiveSheet.Unprotect Password:="1234"
'printer pdf
CreateObject("WScript.Network").SetDefaultPrinter "PDFCreator"
'add date in cell
Sheets("Dubort Et Rainville").Select
Range("D7").Select
Selection.ClearContents
Selection.NumberFormat = "yyyy-mm-dd"
ActiveCell = Now
'copy in pdf
Sheets("Dubort Et Rainville").Select
Application.CopyObjectsWithCells = True
Sheets("Dubort Et Rainville").Copy After:=Sheets(2)
strDate = Format(Date, "yyyy-mm-dd")
With ActiveSheet
.Name = strDate & "-" & Range("B3") & "-" & Range("D9")
End With
' copy to lan folder
ActiveSheet.Select
ActiveSheet.Copy
Dim MyName As String
With ActiveSheet.Select
MyName = strDate & "-" & Range("B3") & "-" & Range("D9")
Path = "F:\Commun\cafétéria\COMMANDE\DUBORT\"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=MyName
Application.DisplayAlerts = True
End With
' preping mail
Dim OlApp As Object
Path = "F:\Commun\cafétéria\COMMANDE\DUBORT\"
Salesman = Split(ActiveWorkbook.Name, ".")(0)
If i > 1 Then PDF_File = Left(PDF_File, i - 1)
PDF_File = Path & Salesman & ".pdf"
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDF_File, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
Set OlApp = CreateObject("Outlook.Application")
With OlApp.CreateItem(0)
.Display
.Subject = "Une commande de la cafétéria" & " " & Range("B3") & "-" & Range("D9") & "-" & strDate
.To = "A@B.ca"
.htmlbody = "<html><body><p>Bonjour,</p><p>Voici une commande de la cafétéria.</p>" _
& "<p>À commander avant midi svp.</p>" _
& "<p> Important avant midi !!!.</p><html><body>" & .htmlbody
.Attachments.Add PDF_File
.Display
Set OlApp = Nothing
End With
ActiveWorkbook.Close savechanges:=True
'erase sheet
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
'erase cell in origin sheet
Sheets("Dubort Et Rainville").Select
Range("C14:C48").Select
Selection.ClearContents
Range("C51:C70").Select
Selection.ClearContents
Range("C73:C103").Select
Selection.ClearContents
Range("C106:C131").Select
Selection.ClearContents
Range("C134:C144").Select
Selection.ClearContents
Range("C147:C176").Select
Selection.ClearContents
Range("C179:C188").Select
Selection.ClearContents
Range("C191:C209").Select
Selection.ClearContents
Range("C212:C240").Select
Selection.ClearContents
Range("C243:C276").Select
Selection.ClearContents
Range("C279:C292").Select
Selection.ClearContents
Range("C295:C327").Select
Selection.ClearContents
Range("C330:C374").Select
Selection.ClearContents
Range("C377:C384").Select
Selection.ClearContents
Range("C387:C404").Select
Selection.ClearContents
Range("C407:C417").Select
Selection.ClearContents
Range("C420:C436").Select
Selection.ClearContents
Range("C439:C478").Select
Selection.ClearContents
Range("C481:C515").Select
Selection.ClearContents
Range("C518:C523").Select
Selection.ClearContents
Range("C526:C543").Select
Selection.ClearContents
Range("C546:C581").Select
Selection.ClearContents
Range("C584:C618").Select
Selection.ClearContents
Range("C621:C655").Select
Selection.ClearContents
Range("C658:C674").Select
Selection.ClearContents
Range("C677:C680").Select
Selection.ClearContents
Range("D9").Select
ActiveSheet.Protect Password:="1234", _
DrawingObjects:=True, Contents:=True, Scenarios:= _
True, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
ActiveSheet.EnableSelection = xlNoRestrictions
End Sub
I'm working on a order sheet for my cook at my school to make is life easyer, it a surprise.
I already got some macro that i'm taking from other part of project to make this one happen.
My macro copy my sheet, next to sheet 2, to never scrap my orignal sheet.
On my copy sheet i want to delete unused row if no quantity in a specific cell, but skiping all the header, like this my sheet will be shorter.
But i'm stuck on that part. I'm pretty sure one of you will find a way to do it.
I'm using A to J to 680.
I got all my title, and info for the order from row 1 to 11, i don't want to touch. I never pass J column.
All start here, i got line 12 and 13 is a header, line 14 to 48 i want to delete row if nothing in C cell on that row.
Then stop for next header line 49 and 50. And deleting row form line 51 to 70 if nothing is found in C cell
Then stop for next header line 71 and 72. And deleting row form line 73 to 103 if nothing is found in C cell
Then stop for next header line 104 and 105. and again and again till last line a 680. (if we need it i can give you all the line for those header or look at the end all the line i want to ''delete'' are there)
after that my macro can transfert it to pdf and attach it on an e-mail then ship it, then erase the copy sheet, and erase all c cell in the original sheet.
I hope you can help me Thanks in advance
Here what i got from now :
Sub Automationdubort()
Sheets("Dubort Et Rainville").Select
ActiveSheet.Unprotect Password:="1234"
'printer pdf
CreateObject("WScript.Network").SetDefaultPrinter "PDFCreator"
'add date in cell
Sheets("Dubort Et Rainville").Select
Range("D7").Select
Selection.ClearContents
Selection.NumberFormat = "yyyy-mm-dd"
ActiveCell = Now
'copy in pdf
Sheets("Dubort Et Rainville").Select
Application.CopyObjectsWithCells = True
Sheets("Dubort Et Rainville").Copy After:=Sheets(2)
strDate = Format(Date, "yyyy-mm-dd")
With ActiveSheet
.Name = strDate & "-" & Range("B3") & "-" & Range("D9")
End With
' copy to lan folder
ActiveSheet.Select
ActiveSheet.Copy
Dim MyName As String
With ActiveSheet.Select
MyName = strDate & "-" & Range("B3") & "-" & Range("D9")
Path = "F:\Commun\cafétéria\COMMANDE\DUBORT\"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=MyName
Application.DisplayAlerts = True
End With
' preping mail
Dim OlApp As Object
Path = "F:\Commun\cafétéria\COMMANDE\DUBORT\"
Salesman = Split(ActiveWorkbook.Name, ".")(0)
If i > 1 Then PDF_File = Left(PDF_File, i - 1)
PDF_File = Path & Salesman & ".pdf"
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDF_File, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
Set OlApp = CreateObject("Outlook.Application")
With OlApp.CreateItem(0)
.Display
.Subject = "Une commande de la cafétéria" & " " & Range("B3") & "-" & Range("D9") & "-" & strDate
.To = "A@B.ca"
.htmlbody = "<html><body><p>Bonjour,</p><p>Voici une commande de la cafétéria.</p>" _
& "<p>À commander avant midi svp.</p>" _
& "<p> Important avant midi !!!.</p><html><body>" & .htmlbody
.Attachments.Add PDF_File
.Display
Set OlApp = Nothing
End With
ActiveWorkbook.Close savechanges:=True
'erase sheet
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
'erase cell in origin sheet
Sheets("Dubort Et Rainville").Select
Range("C14:C48").Select
Selection.ClearContents
Range("C51:C70").Select
Selection.ClearContents
Range("C73:C103").Select
Selection.ClearContents
Range("C106:C131").Select
Selection.ClearContents
Range("C134:C144").Select
Selection.ClearContents
Range("C147:C176").Select
Selection.ClearContents
Range("C179:C188").Select
Selection.ClearContents
Range("C191:C209").Select
Selection.ClearContents
Range("C212:C240").Select
Selection.ClearContents
Range("C243:C276").Select
Selection.ClearContents
Range("C279:C292").Select
Selection.ClearContents
Range("C295:C327").Select
Selection.ClearContents
Range("C330:C374").Select
Selection.ClearContents
Range("C377:C384").Select
Selection.ClearContents
Range("C387:C404").Select
Selection.ClearContents
Range("C407:C417").Select
Selection.ClearContents
Range("C420:C436").Select
Selection.ClearContents
Range("C439:C478").Select
Selection.ClearContents
Range("C481:C515").Select
Selection.ClearContents
Range("C518:C523").Select
Selection.ClearContents
Range("C526:C543").Select
Selection.ClearContents
Range("C546:C581").Select
Selection.ClearContents
Range("C584:C618").Select
Selection.ClearContents
Range("C621:C655").Select
Selection.ClearContents
Range("C658:C674").Select
Selection.ClearContents
Range("C677:C680").Select
Selection.ClearContents
Range("D9").Select
ActiveSheet.Protect Password:="1234", _
DrawingObjects:=True, Contents:=True, Scenarios:= _
True, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
ActiveSheet.EnableSelection = xlNoRestrictions
End Sub