Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Hi there!
Is there any code which you can help me with to copy HIDDEN COLUMNS to a new workbook. I'm using below codes: (COLUMNS HIDDEN are columns J-K-L) Sub Copy_With_AutoFilter1() 'Note: This macro use the function LastRow Dim My_Range As Range Dim CalcMode As Long Dim ViewMode As Long Dim FilterCriteria As String Dim CCount As Long Dim WSNew As Worksheet Dim sheetName As String Dim rng As Range Dim WS As Worksheet Set My_Range = Worksheets("Sheet1").Range("A1:BN" & LastRow(Worksheets("Sheet1"))) My_Range.Parent.Select If ActiveWorkbook.ProtectStructure = True Or _ My_Range.Parent.ProtectContents = True Then ActiveWorkbook.Unprotect ("sda") End If ActiveSheet.Unprotect ("sda") 'Change ScreenUpdating, Calculation, EnableEvents, .... With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False .EnableEvents = False End With ViewMode = ActiveWindow.View ActiveWindow.View = xlNormalView ActiveSheet.DisplayPageBreaks = False 'Firstly, remove the AutoFilter My_Range.Parent.AutoFilterMode = False 'If you want to filter on a Inputbox value use this FilterCriteria = InputBox("What text do you want to filter on?", _ "Enter the filter item.") My_Range.autofilter Field:=4, Criteria1:="=" & FilterCriteria 'Check if there are not more then 8192 areas(limit of areas that Excel can copy) CCount = 0 On Error Resume Next CCount = My_Range.Columns(1).SpecialCells(xlCellTypeVisible ).Areas(1).Cells.Count On Error GoTo 0 If CCount = 0 Then MsgBox "There are more than 8192 areas:" _ & vbNewLine & "It is not possible to copy the visible data." _ & vbNewLine & "Tip: Sort your data before you use this macro.", _ vbOKOnly, "Copy to worksheet" Else Set WSNew = Workbooks.Add(xlWBATWorksheet).Worksheets(1) 'Ask for the Worksheet name sheetName = InputBox("What is the name of the new worksheet?", _ "Name the New Sheet") On Error Resume Next WSNew.Name = sheetName If Err.Number 0 Then MsgBox "Change the name of sheet : " & WSNew.Name & _ " manually after the macro is ready. The sheet name" & _ " you fill in already exists or you use characters" & _ " that are not allowed in a sheet name." Err.Clear End If On Error GoTo 0 'Copy/paste the visible data to the new worksheet Selection.EntireColumn.Hidden = False My_Range.Parent.autofilter.Range.Copy With WSNew.Range("A1") ' Paste:=8 will copy the columnwidth in Excel 2000 and higher ' Remove this line if you use Excel 97 .PasteSpecial Paste:=8 .PasteSpecial xlPasteAll Application.CutCopyMode = False .Select ActiveSheet.Protection.AllowEditRanges.Add Title:="Range1", Range:=Columns("AS:AX") End With Selection.autofilter ActiveSheet.Protect ("sda") End If 'Close AutoFilter My_Range.Parent.AutoFilterMode = False 'Restore ScreenUpdating, Calculation, EnableEvents, .... ActiveWindow.View = ViewMode If Not WSNew Is Nothing Then WSNew.Select With Application .ScreenUpdating = True .EnableEvents = True .Calculation = CalcMode End With My_Range.Parent.Protect Password:="sda" End Sub |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Copy and Paste with hidden columns remaining hidden | Excel Discussion (Misc queries) | |||
Not include hidden columns in copy paste | Excel Discussion (Misc queries) | |||
How do I copy a worksheet so that hidden columns remain secret? | Excel Discussion (Misc queries) | |||
macro to insert row, copy cells and keep hidden columns | Excel Programming | |||
COPY - *want* to include hidden columns | Excel Programming |