Another way to copy data and create new workbook and paste it

Another way to copy data and create new workbook and paste it






Sub CopyItOver()
  Set Newbook = Workbooks.Add
  Workbooks("CENTRUM REPLENISHMENT TEMPLATE.xlsm").Worksheets("Master Order Template").Copy
  Newbook.Worksheets("Sheet1").PasteSpecial Paste:=xlPasteValues
 ' NewBook.SaveAs Filename:=NewBook.Worksheets("Sheet1").Range("E3").Value
   'ThisWorkbook.Close Savechanges = False
End Sub

Sub CopyOver2()
Dim newWB As Workbook, currentWB As Workbook
Dim newS As Worksheet, currentS As Worksheet
Dim xStrDate As String
Dim xFileName As String
Dim xJBName As String
Dim xLocation As String

'Copy the data you need
'Set currentWB = ThisWorkbook
Set currentS = Workbooks("CENTRUM REPLENISHMENT TEMPLATE.xlsm").Sheets("MASTER ORDER TEMPLATE")

currentS.Range("A:AT").Select
Selection.Copy

'Create a new file that will receive the data
xStrDate = Format(Now, "mmdd_hhmm")
xJBName = Workbooks("CENTRUM REPLENISHMENT TEMPLATE.xlsm").Sheets("Store Input").Range("B9").Value & "_"
xLocation = Workbooks("CENTRUM REPLENISHMENT TEMPLATE.xlsm").Sheets("Store Input").Range("$J$24").Value
Set newWB = Workbooks.Add
    With newWB
        Set newS = newWB.Sheets("Sheet1")
        newS.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        newS.Range("A1").PasteSpecial Paste:=xlPasteFormats
        Rows("1:10").EntireRow.Hidden = True
        ActiveSheet.Name = Workbooks("CENTRUM REPLENISHMENT TEMPLATE.xlsm").Sheets("Store Input").Range("J30").Value
        'Save in CSV
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:=xLocation & "Order Template\" & xJBName & xStrDate, FileFormat:=xlWorkbookNormal
        Application.DisplayAlerts = True
      ActiveWorkbook.Close Savechanges:=True

'ThisWorkbook.Show = False
        End With
'SendWorkBook


End Sub

To hide and and protect sheet and specific column

To hide and  and protect sheet and column

Sub SetActive()
    Worksheets("STORE INPUT").Activate
    Worksheets("STORE INPUT").Range("U21").Activate

End Sub
 

Public Sub UnhideInput()
    Worksheets("STORE INPUT").Activate
    ActiveSheet.AutoFilterMode = False
    Columns("G:Z").EntireColumn.Hidden = False

 
End Sub

Public Sub HideInput()
    Worksheets("STORE INPUT").Activate
    ActiveSheet.AutoFilterMode = False
    Columns("G:Z").EntireColumn.Hidden = True
End Sub

Public Sub ProtectInput()
    Worksheets("STORE INPUT").Activate
    ActiveSheet.AutoFilterMode = False
    ActiveSheet.Protect Password:="CENTRUM17"
End Sub

Public Sub UnProtectInput()
    Worksheets("STORE INPUT").Activate
    ActiveSheet.AutoFilterMode = False
    ActiveSheet.Unprotect Password:="CENTRUM17"
End Sub

Public Sub GoToSWS()
 Worksheets("STORE INPUT").Activate
    Worksheets("STORE INPUT").Range("A36").Activate

End Sub



Sub Clear_All()

    Range("K13:K300").Select
    Selection.ClearContents
        Range("N13:N300").Select
    Selection.ClearContents
        Range("R13:R300").Select
    Selection.ClearContents

End Sub

Public Sub UnHideMOTRow()
  ActiveWorkbook.Sheets("MASTER ORDER TEMPLATE").Activate
  Rows("2:10").EntireRow.Hidden = False
  Rows("11:12").EntireRow.Hidden = True
 
End Sub

Public Sub HideMOTRow()
  ActiveWorkbook.Sheets("MASTER ORDER TEMPLATE").Activate
   ActiveSheet.AutoFilterMode = False
  Rows("2:10").EntireRow.Hidden = True
  Rows("11:12").EntireRow.Hidden = False
End Sub

Public Sub UnHideMOTColumn()
  ActiveWorkbook.Sheets("MASTER ORDER TEMPLATE").Activate
  ActiveSheet.AutoFilterMode = False
 Columns("W:AT").EntireColumn.Hidden = False
 
End Sub

Public Sub HideMOTColumn()
 Workbooks("CENTRUM REPLENISHMENT TEMPLATE.xlsm").Worksheets("Master Order Template").Activate
  ActiveSheet.AutoFilterMode = False
 Columns("W:AT").EntireColumn.Hidden = True
 
End Sub
Public Sub ProtectMOT()
  ActiveWorkbook.Sheets("MASTER ORDER TEMPLATE").Activate
  ActiveSheet.Protect Password:="CENTRUM17"
'  ActiveSheet.AutoFilterMode = True
End Sub
Public Sub UnProtectMOT()
  ActiveWorkbook.Sheets("MASTER ORDER TEMPLATE").Activate
 ActiveSheet.Unprotect Password:="CENTRUM17"

 
End Sub


Sub ViewMOTFiltered()
    Worksheets("MASTER ORDER TEMPLATE").Activate
    Worksheets("MASTER ORDER TEMPLATE").Range("A12").Activate
  ActiveSheet.AutoFilterMode = False
  ActiveSheet.Range("$A$12:$AP$300").AutoFilter Field:=24, Criteria1:=Array("Y", "NT"), Operator:=xlFilterValues
End Sub

Sub ViewMOT2()
    Worksheets("MASTER ORDER TEMPLATE").Activate
    Worksheets("MASTER ORDER TEMPLATE").Range("A12").Activate

End Sub
   

To attach active work book and send to outlook

    To attach active work book and send to outlook




Dim objOutlook As Object
    Set objOutlook = CreateObject("Outlook.Application")
    Dim xStrDate As String
    Dim xJBName As String
   
    On Error GoTo ErrHandler
   
   
    xStrDate = Format(Now, "mm-dd-yyyy")
    xJBName = Workbooks("CENTRUM REPLENISHMENT TEMPLATE.xlsm").Sheets("Store Input").Range("B9").Value
    ' CREATE EMAIL OBJECT.
    Dim objEmail As Object
    Set objEmail = objOutlook.CreateItem(olMailItem)

    With objEmail
    .to = "celine.bautista@jollibee.com.ph"
    .CC = ""
    .BCC = ""
    .Subject = "CENTRUM: Order Template test2"
    .Body = "CENTRUM Order Template for " & xJBName & vbNewLine & "Date generated: " & xStrDate
    .Attachments.Add Application.ActiveWorkbook.FullName
    .Send
   
    End With
    ' CLEAR.
    Set objEmail = Nothing:    Set objOutlook = Nothing
       
      MsgBox "CENTRUM ORDER TEMPLATE SENT!"
   Exit Sub
       
       
ErrHandler:
Set OutMail = Nothing
Set OutApp = Nothing
err.Clear
MsgBox "Please manually send your File!"

To export all sheet to PDF/To export as pdf active sheet

To export all sheet to PDF


Sub exportAllSheetsTopdf()
fName = ActiveWorkbook.FullName

If InStr(fName, ".") > 0 Then fName = Left(fName, InStrRev(fName, ".") - 1)

ActiveWorkbook.ExportAsFixedFormat xlTypePDF, fName & ".pdf", _
                                   xlQualityStandard, , , , , True
End Sub
---------------------------------------------------------------------------

To export as pdf active sheet

Sub PDFActiveSheet()
'www.contextures.com
'for Excel 2010 and later
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")

'get active workbook folder, if saved
strPath = wbA.path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")

'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile

'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Select Folder and FileName to save")

'export to PDF if a folder was selected
If myFile <> "False" Then
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    'confirmation message with file info
    MsgBox "PDF file has been created: " _
      & vbCrLf _
      & myFile
End If

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
End Sub

To delete specific sheet by name

To delete specific sheet by name

******changes the shName base on name of sheet

Sub Deletebyname()
'Updateby Extendoffice 20160930
    Dim shName As String
    Dim xName As String
    Dim xWs As Worksheet
    Dim cnt As Integer
    shName = "Sheet"
                                    ''ThisWorkbook.ActiveSheet.Name, , , , , 2)
    If shName = "" Then Exit Sub
    xName = "*" & shName & "*"
'    MsgBox xName
    Application.DisplayAlerts = False
    cnt = 0
    For Each xWs In ThisWorkbook.Sheets
        If xWs.Name Like xName Then
            xWs.delete
            cnt = cnt + 1
        End If
    Next xWs
    Application.DisplayAlerts = True
    MsgBox "Have deleted" & cnt & "worksheets", vbInformation, "Kutools for Excel"
End Sub

To copy whole sheets to another workbook

To copy whole sheets to another workbook

Sub GetSheets()
Dim path As String
path = Sheets("DO NOT DELETE").Range("e1")
Filename = Dir(path & "*.xls")
  Do While Filename <> ""
  Workbooks.Open Filename:=path & Filename, ReadOnly:=True
     For Each Sheet In ActiveWorkbook.Sheets
     Sheet.Copy After:=ThisWorkbook.Sheets(1)
  Next Sheet
     Workbooks(Filename).Close
     Filename = Dir()
  Loop
 

End Sub

Protect all worksheets and unprotect

Protect all worksheets and unprotect


Sub ProtectAll()

Dim wsheet As Worksheet

For Each wsheet In ActiveWorkbook.Worksheets

wsheet.Protect password:="123"

Next wsheet

End Sub
----------------------------------------------------------------------------
Sub DeProtectAll()

Dim wsheet As Worksheet



    For Each wsheet In ActiveWorkbook.Worksheets
    wsheet.Unprotect password:="123"
     
       
    Next wsheet
End Sub