Snasui Excel Forum

Code: Select all

Sub AddNew()
     
    Dim wbName As String
     
    wbName = [A1].Value
     
    Set NewBook = Workbooks.Add
    With NewBook
        .Title = wbName
         ' add your additional code here
        .SaveAs Filename:=wbName
    End With
End Sub

Code: Select all

Sub AddNew()
     
    Dim wbName As String
     
    wbName = [A1].Value
     
    Set NewBook = Workbooks.Add
    With NewBook
        .Title = wbName
         ' add your additional code here
        .SaveAs Filename:=wbName
    End With
    Call CopyPaste
    
End Sub

Sub CopyPaste()
'
' Macro3 Macro
'

'
    Range("A2:G6").Select
    Selection.Copy
    Windows("UserID.xlsx").Activate
    Range("A2").Select
    ActiveSheet.Paste
End Sub

Code: Select all

Sub AddNew()
     
    Dim wbName As String
    Dim rAll As Range
    Dim rTarget As Range
    
    Set rAll = Sheets("tblUsers").Range("A2:G6")
    wbName = [A1].Value
     
    Set NewBook = Workbooks.Add
    With NewBook
        Set rTarget = Sheets("Sheet1").Range("A1")
        .Title = wbName
         ' add your additional code here
         rAll.Copy rTarget
        .SaveAs Filename:=wbName
    End With
'    Call CopyPaste
    
End Sub

Code: Select all

Sub AddNewbomxxTEST()
     
    Dim wbName As String
    Dim rAll As Range
    Dim rTarget As Range
    
    Set rAll = Sheets("Report0").Range("A2:k43")
    wbName = [I1].Value
     
    Set NewBook = Workbooks.Add
    With NewBook
        Set rTarget = Sheets("Sheet1").Range("A1")
        .Title = wbName
         ' add your additional code here
         rAll.Copy rTarget
        .SaveAs Filename:=wbName
    End With
'    Call CopyPaste
    
End Sub

    
Sub CopyPaste()
'
' Macro3 Macro
'

'
    Range("A2:k43").Select
    Selection.Copy
    Windows("UserID.xlsx").Activate
    Range("A2").Select
    ActiveSheet.Paste
End Sub

Code: Select all

Sub AddNew()
     
  Dim wbName As String
    Dim rAll As Range
    Dim rTarget As Range
    
    Set rAll = Sheets("Report0").Range("A1:k43")
    wbName = [I1].Value
     
    Set NewBook = Workbooks.Add
    With NewBook
        Set rTarget = Sheets("Sheet1").Range("A1")
        .Title = wbName
         ' add your additional code here
         rAll.Copy rTarget
        .SaveAs Filename:=wbName
    End With
'    Call CopyPasteokmai
    
End Sub

Sub CopyPasteokmai()
 Range("A1:k43").Select
    Selection.Copy
    Windows("UserID.xlsx").Activate
    Range("A2").Select
    ActiveSheet.Paste
 Windows("UserID.xlsx").Activate
Range("A1:J42").Select
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("L25").Select
End Sub

Code: Select all

Sub CreateNew()
    Sheets("Report0").Select
    Sheets("Report0").Copy
Application.DisplayAlerts = False
With ActiveWorkbook
wbName = [I1].Value
    .Title = wbName
    .SaveAs Filename:=wbName
End With
Application.DisplayAlerts = True
End Sub

Code: Select all

Sub CreateNew()
 Sheets("Report0").Select
    Sheets("Report0").Copy
Application.DisplayAlerts = False
With ActiveWorkbook
wbName = [I1].Value
    .Title = wbName
    .SaveAs Filename:=wbName
End With
Application.DisplayAlerts = True
End Sub

Code: Select all

.SaveAs Filename:"L:\Quality System\YEAR 2013\"&wbName

Code: Select all

Sub checkred_blank()
If Worksheets("report0").Range("H10") = "" Then
 MsgBox "You have to enter data"
 Else
  Call Sheet1.CreateNew
 End If
 End Sub

Code: Select all

Sub AddNew()
     
  Dim wbName As String
    Dim rAll As Range
    Dim rTarget As Range
    
    Set rAll = Sheets("Report0").Range("A1:k43")
    wbName = [I1].Value
     
    Set NewBook = Workbooks.Add
    With NewBook
        Set rTarget = Sheets("Sheet1").Range("A1")
        .Title = wbName
         ' add your additional code here
         rAll.Copy rTarget
        .SaveAs Filename:="D:\KEEPER_BOM\" & wbName
       
    End With
'    Call CopyPasteokmai
    
End Sub