Hiding rows and columns for copying

[Lallo]

I have a sheet with data, where I want to copy only visible cells to an new sheet. There are already hidden rows (through filtering), but I need to hide additional rows, as well as the columns I don't need.

The reason I paste as picture is that I want the copied cells to look exactly like in the original sheet, values and formatting.

The new sheet will be converted into a pdf file (code not included here)

Sheets.Add.Name = "shttemp"

Sheets("Sheet3").Select

Dim LR As Long
LR = Columns("A:A").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row

With ActiveSheet

Range("B:B, D:D, F:F").Select

Selection.EntireColumn.Hidden = True

Rows(LR + 1 & ":600").Select
Selection.EntireRow.Hidden = True


Range("A3:M500").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("shttemp").Select
Range("A1").Select
ActiveSheet.Pictures.Paste.Select

End With

Sheets("Sheet3").Select
Range("B:B, D:D, F:F").Select
Selection.EntireColumn.Hidden = False

Sheets("Sheet3").Select
Rows(LR + 1 & ":600").Select
Selection.EntireRow.Hidden = False

Sheets("shttemp").Select

Now, this works for the ROWS but not for the COLUMNS, i.e. the columns remain in the new sheet. Odd thing is, in an earlier version I only used the code for the columns, and it worked fine.

Any ideas?

 

[Lallo]

Sorted!

Silly mistake.. A G instead of an M in the column selection command makes a world of difference.

Also simplified the code somewhat. If anyone is interested, here's the result:

Sheets.Add.Name = "shttemp"

    Sheets("Blad3").Select
    
    Dim LR As Long
    LR = Columns("A:M").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    
    With ActiveSheet
    
    Range("B:B, D:D, F:F").Select
    
    Selection.EntireColumn.Hidden = True
    
        
    Range("A3:G" & LR).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    
    
    
    Sheets("shttemp").Select
    Range("A1").Select
    ActiveSheet.Pictures.Paste.Select
    
    End With
    
      
    Sheets("Blad3").Select
    Range("B:B, D:D, F:F").Select
    Selection.EntireColumn.Hidden = False
    
        
    Sheets("shttemp").Select

Thanks for caring!

 

[cgcamal]

Hi Lallo,

I tried your code and when the cells are copied as image, the number of columns in the image I think is correct = 10 (from A to J),
because in Sheet3 your code selects from A to M (13 columns) minus 3 you hide we get 10.

I´m not sure what you need. May you show a sample input and desired output
image in new sheet "shttemp".

Additionally, in order your code be smaller and faster, you can do the same without use "select". I mean,
Instead of:

Range("B:B, D:D, F:F")[COLOR=Red].Select[/COLOR]

[COLOR=Red]Selection[/COLOR].EntireColumn.Hidden = True

You can replace "Selection" part and use directly the range itself:

[COLOR=Red]Range("B:B, D:D, F:F")[/COLOR].EntireColumn.Hidden = True

This gives you a compacted code and for this case, a compacted version
of your code will look like this:

Sub Paste_As_Image()
Dim LR As Long

Sheets.Add.Name = "shttemp"

With Sheets("Sheet3")
LR = .Columns("A:A").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
.Range("B:B, D:D, F:F").EntireColumn.Hidden = True
.Rows(LR + 1 & ":600").EntireRow.Hidden = True
.Range("A3:M500").SpecialCells(xlCellTypeVisible).Copy

    Sheets("shttemp").Pictures.Paste [COLOR=Green]'Paste cells as image[/COLOR]

.Range("B:B, D:D, F:F").EntireColumn.Hidden = False
.Rows(LR + 1 & ":600").EntireRow.Hidden = False
 Application.CutCopyMode = False
End With

End Sub

Hope this helps.

Regards

 

[Lallo]

@ cgcamal.

Muchas Gracias!