Consulting

Results 1 to 2 of 2

Thread: Values and formats of only visible sheets and ranges copied to a new book

  1. #1
    VBAX Regular
    Joined
    Oct 2004
    Posts
    65
    Location

    Values and formats of only visible sheets and ranges copied to a new book

    Hi all,

    I found this code in the Kb (Thanks to Justinlabenne for posting it) to copy Specific sheets to a new workbook but I need add a little twist to it.
    What I need if for the code to only copy Visible sheets and Columns and rows (not copy any worksheet that is hidden ( i am using VB Very hidden) and not to copy any rows or columns that are hidden).

    Basically what I need is the Values and formats of only visible sheets and ranges copied to a new book


    http://www.vbaexpress.com/kb/getarticle.php?kb_id=359

    [VBA]

    Option Explicit

    Sub TwoSheetsAndYourOut()
    Dim NewName As String
    Dim nm As Name
    Dim ws As Worksheet

    If MsgBox("Copy specific sheets to a new workbook" & vbCr & _
    "New sheets will be pasted as values, named ranges removed" _
    , vbYesNo, "NewCopy") = vbNo Then Exit Sub

    With Application
    .ScreenUpdating = False

    ' Copy specific sheets
    ' *SET THE SHEET NAMES TO COPY BELOW*
    ' Array("Sheet Name", "Another sheet name", "And Another"))
    ' Sheet names go inside quotes, seperated by commas
    On Error Goto ErrCatcher
    Sheets(Array("Copy Me", "Copy Me2")).Copy
    On Error Goto 0

    ' Paste sheets as values
    ' Remove External Links, Hperlinks and hard-code formulas
    ' Make sure A1 is selected on all sheets
    For Each ws In ActiveWorkbook.Worksheets
    ws.Cells.Copy
    ws.[A1].PasteSpecial Paste:=xlValues
    ws.Cells.Hyperlinks.Delete
    Application.CutCopyMode = False
    Cells(1, 1).Select
    ws.Activate
    Next ws
    Cells(1, 1).Select

    ' Remove named ranges
    For Each nm In ActiveWorkbook.Names
    nm.Delete
    Next nm

    ' Input box to name new file
    NewName = InputBox("Please Specify the name of your new workbook", "New Copy")

    ' Save it with the NewName and in the same directory as original
    ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls"
    ActiveWorkbook.Close SaveChanges:=False

    .ScreenUpdating = True
    End With
    Exit Sub

    ErrCatcher:
    MsgBox "Specified sheets do not exist within this workbook"
    End Sub


    [/VBA]

    thanks
    We are living in a world today
    where lemonade is made from
    artificial flavoring and furniture polish
    is made from real lemons...
    Alfred E Newman

  2. #2
    VBAX Regular
    Joined
    Aug 2007
    Location
    Hungary Budapest
    Posts
    53
    Location
    hali,
    the following will cos you copy only the visible sheets:
    [VBA]
    Dim wc()
    ReDim wc(0 To 0)
    For Each ws In ActiveWorkbook.Worksheets
    If ws.Visible = xlSheetVisible Then
    If wc(UBound(wc)) = "" Then
    wc(0) = ws.Name
    Else
    ReDim Preserve wc(0 To UBound(wc) + 1)
    wc(UBound(wc)) = ws.Name
    End If
    End If
    Next ws
    Sheets(wc).Copy
    [/VBA]

    the visible rows and cols need others
    regards
    L@ja

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •