AddSheets Code into ExportData Code

ArhamRajput · Apr 30th 2020

Dear Experts I want to merge Addsheet code into ExportData code bu could not please help.

Code

Private Sub Export_Data()
Sheet1.Range("B2:G17").Select
Selection.Copy
Worksheets.Add
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, operation:=xlNone, skipblanks:=False, Transpose:=False
Application.CutCopyMode = False
    Range("A1:G14").Select
    With Selection
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Cells.Select
    Cells.EntireColumn.AutoFit
    
End Sub



Sub AddSheets() 
 Dim NewName As String 
Another: 
 OneMore = False 
 NewName = InputBox("What Do you Want to Name the New Sheet?") 
 Sheets.Add 
 ActiveSheet.Name = NewName 
 If MsgBox("Do you want to Add another Sheet?", vbYesNo) = 6 Then Goto Another 
End Sub

Display More

**royUK** · Apr 30th 2020

Do you mean like this?

Code

Private Sub Export_Data()
Dim NewName As String


NewName = InputBox("What Do you Want to Name the New Sheet?")
If Len(NewName) = 0 Then
MsgBox "You must provide a name for the new sheet", vbCritical, "Name required"
Exit Sub
End If


Sheets.Add(After:=Sheets(Sheets.Count)).Name = NewName
Sheet1.Range("B2:G17").Copy
Sheet1.Range("B2:G17").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, operation:=xlNone, skipblanks:=False, Transpose:=False
Application.CutCopyMode = False


With Range("A1:G14")
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Range("A1:G14")
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

ActiveSheet.EntireColumn.AutoFit
End Sub

Display More

ArhamRajput · Apr 30th 2020

Thankyou so much

ArhamRajput · Apr 30th 2020

Roy its not pasting the data in new sheet

**royUK** · Apr 30th 2020

Try this

Code

Private Sub Export_Data()
Dim NewName As String


Set oWs = ActiveSheet


NewName = InputBox("What Do you Want to Name the New Sheet?")
If Len(NewName) = 0 Then
MsgBox "You must provide a name for the new sheet", vbCritical, "Name required"
Exit Sub
End If


Sheets.Add(After:=Sheets(Sheets.Count)).Name = NewName
Sheet1.Range("B2:G17").Copy
With ActiveSheet
.Range("B2:G17").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, operation:=xlNone, skipblanks:=False, Transpose:=False
Application.CutCopyMode = False


With .Range("A1:G14")
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With .Range("A1:G14")
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With


.EntireColumn.AutoFit
End With
End Sub

Display More

ArhamRajput · May 1st 2020

No your code is still no pasting

**royUK** · May 1st 2020

In that case I need to see the workbook.

AddSheets Code into ExportData Code

Participate now!

Share