VBA to Copy two worksheets to New Workbook

[Malhotra Rahul]

Hi, I am using the below script for copy two worksheet to a new workbook but i do have two issue with this:

With the available script:

1) As my original worksheet alternate rows are filled with specific color, which is getting change after copying the data to new worksheet.

2) When the pop up ask for giving the new name to the workbook then also it takes automatically a new name like Book8 and not the given name.

Option Explicit

Sub RunMacro1_Click()


    
        Dim NewName As String, s As String, wb As Workbook, ws As Worksheet, i As Integer, x
    
    s = "MySheet1 & MySheet2"  '//EDIT OR ADD SHEETS TO BE COPIED HERE (INCLUDE '<space>&<space>' BETWEEN NAMES)
    x = Split(s, " & ")
    
    If MsgBox("Sheets:" & vbCr & vbCr & s & vbCr & vbCr & "will be copied to a new workbook" & vbCr & vbCr & _
    "The sheets will be values only (named ranges, formulas and links removed)" & vbCr & vbCr & _
    "Do you want to continue?", vbYesNo, "Create New Workbook") = vbNo Then Exit Sub
    
    NewName = InputBox("Please Enter the name for the new workbook", "New Workbook Name")


    Application.ScreenUpdating = False
    Workbooks.Add
    Set wb = ActiveWorkbook
    With wb
        For i = 0 To UBound(x)
            Set ws = ThisWorkbook.Sheets(x(i))
            ws.Cells.Copy
            .Sheets.Add after:=Sheets(Sheets.Count): .ActiveSheet.name = x(i)
            With .Sheets(x(i))
                .[a1].PasteSpecial Paste:=xlValues
                .Cells.PasteSpecial Paste:=xlFormats
                .Cells.Hyperlinks.Delete
                Application.Goto .[a1]
            End With
        Next
        Application.DisplayAlerts = False
        For i = 1 To 1
            .Sheets("Sheet" & i).Delete
        Next
        Application.DisplayAlerts = True
        .SaveAs (NewName & ".xls")
    End With
    ThisWorkbook.Close SaveChanges:=False
    Application.ScreenUpdating = True


    
End Sub

Any help would be highly appreciated. Thank you in advance.</space></space>

 

[Malhotra Rahul]

Hi, I do have issue only for the point 1 for changing color while copying to the new worksheets but not the second one.

 

[Fluff]

It sounds like you are not using the default colour scheme.
Try recording a macro of you setting the colour scheme you want & then you can add that to your macro

 

[igold]

Does this get you any closer to what you want to do. This will keep your formatting and formulas from the copied sheets.

Sub RunMacro1_Click()




    Dim NewName As String
    
    Worksheets(Array("MySheet1", "MySheet2")).Copy
    NewName = InputBox("Please Enter the name for the new workbook", "New Workbook Name")
    With ActiveWorkbook
        .SaveAs (NewName & ".xls")
        .Close savechanges:=True
    End With
    ThisWorkbook.Close savechanges:=False
    
End Sub

I hope this helps.

 

[Malhotra Rahul]

I could have done that but the problem is both worksheets color ranges a different for MySheet1 the below script i am using for alternate row color:

Private Sub worksheet_SelectionChange(ByVal target As Range)

Dim i, c As Range, FRows, rng As Range
    Set rng = Cells(12, 2).Resize(Cells(Rows.Count, 2).End(xlUp).Row - 11)
    
    With CreateObject("scripting.dictionary")
        For Each c In rng.Cells
            If c.EntireRow.Hidden = False Then
                i = i + 1
                .Item(i) = i Mod 2
                Select Case c.Row
                    Case 11, 62, 63, 113, 114 To 117, 164 To 165, 195 To 196, 320, 321, 357, 358, 370 To 381
                    Case Else
                    If .Item(i) = 1 And InStr(c.Value, "Blank") = 0 Then
                        c.Resize(, 18).Interior.ColorIndex = 22 'SkyBlue
                        Else
                        c.Resize(, 18).Interior.ColorIndex = -4142 'White
                    End If
                End Select
            End If
        Next c
    End With
End If
End Sub

and for MySheet2 i am using the below script for changing the alternate row color:

Private Sub worksheet_SelectionChange(ByVal target As Range)

Dim i, c As Range, FRows, rng As Range
    Set rng = Cells(12, 2).Resize(Cells(Rows.Count, 2).End(xlUp).Row - 11)
    
    With CreateObject("scripting.dictionary")
        For Each c In rng.Cells
            If c.EntireRow.Hidden = False Then
                i = i + 1
                .Item(i) = i Mod 2
                Select Case c.Row
                    Case 11, 62, 63, 113 To 117, 118, 119, 166 To 167, 197, 198 To 200, 324 To 329, 365, 366, 378 To 384
                    Case Else
                    If .Item(i) = 1 And InStr(c.Value, "Blank") = 0 Then
                        c.Resize(, 14).Interior.ColorIndex = 22 'SkyBlue
                        Else
                        c.Resize(, 14).Interior.ColorIndex = -4142 'White
                    End If
                End Select
            End If
        Next c
    End With
End If
End Sub

Now the problem for me is how to incorporate these two different colors with in the single above script. Because both worksheets rows and columns range are different.

and i while copying i also want to skip the hidden rows and columns to copy.

 

[igold]

Hi,

Did you see/try my Post #4 .

 

[Malhotra Rahul]

Does this get you any closer to what you want to do. This will keep your formatting and formulas from the copied sheets.

Sub RunMacro1_Click()




    Dim NewName As String
    
    Worksheets(Array("MySheet1", "MySheet2")).Copy
    NewName = InputBox("Please Enter the name for the new workbook", "New Workbook Name")
    With ActiveWorkbook
        .SaveAs (NewName & ".xls")
        .Close savechanges:=True
    End With
    ThisWorkbook.Close savechanges:=False
    
End Sub

I hope this helps.

The provided script is copying bar graphs and formulae as well which is throwing error in the new worksheet as #Ref but script which i am currently using copies only the print range not the shapes.

 

[igold]

Ah, I was trying to overcome the obstacles you stated as 1) and 2) in your OP.

 

[Fluff]

As ColorIndex 22 is a reddish colour not SkyBlue, you must have some sort of custom colour pallet, which you will need to copy over to the new workbook.

 

[Malhotra Rahul]

Hi Fluff, but it's giving me the sky blue colour. Which is visible in green red and black font.