Home Only copy visible range in VBA?
Reply: 4

Only copy visible range in VBA?

Gurrito
1#
Gurrito Published in 2018-02-14 13:24:35Z

I'm running into an issue where I'm unable to copy only visible cells to a new sheet. I'm able to get the lastrow, but I get #N/A on every cell except the first for each column. I want to just copy the visible cells. I'd also like to only put information on visible rows too, if possible?

Please see my code below:

Sub Importe()
lastRow = Worksheets("Sheet1").Cells(1, 1).SpecialCells(xlCellTypeVisible).End(xlDown).Row

Worksheets.Add

With ActiveSheet
  Range("A1:A" & lastRow).Value2 = _
  ActiveWorkbook.Worksheets("Sheet1").Range("H1:H" & lastRow).SpecialCells(xlCellTypeVisible).Value
  Range("B1:B" & lastRow).Value2 = _
  ActiveWorkbook.Worksheets("Sheet1").Range("E1:E" & lastRow).SpecialCells(xlCellTypeVisible).Value
End With

End Sub
Pᴇʜ
2#
Pᴇʜ Reply to 2018-02-14 15:04:45Z

Something like .Value2 = .Value doesn't work on special cells of type visible, because …

… e.g. if lastRow = 50 and there are hiddenRows = 10 then …

  • your source Range("H1:H" & lastRow).SpecialCells(xlCellTypeVisible)
    has lastRow - hiddenRows = 40 rows
  • but your destination Range("A1:A" & lastRow).Value2
    has lastRow = 50 rows.

On the first you subtract the visible rows, so they are different in size. Therefore .Value2 = .Value doesn't work, because you cannot fill 50 rows with only 40 source rows.

But what you can do is Copy and SpecialPaste

Option Explicit

Sub Importe()
    Dim lastRow As Long

    lastRow = Worksheets("Sheet1").Cells(1, 1).SpecialCells(xlCellTypeVisible).End(xlDown).Row

    Worksheets.Add

    With ActiveSheet
       ActiveWorkbook.Worksheets("Sheet1").Range("H1:H" & lastRow).SpecialCells(xlCellTypeVisible).Copy
       .Range("A1").PasteSpecial xlPasteValues

       ActiveWorkbook.Worksheets("Sheet1").Range("E1:E" & lastRow).SpecialCells(xlCellTypeVisible).Copy
       .Range("B1").PasteSpecial xlPasteValues
    End With
End Sub

Nevertheless I recommend to avoid ActiveSheet or ActiveWorkbook if this is possible and reference a workbook eg by ThisWorkbook. My suggestion:

Option Explicit

Sub Importe()
    Dim SourceWs As Worksheet
    Set SourceWs = ThisWorkbook.Worksheets("Sheet1")

    Dim DestinationWs As Worksheet
    Set DestinationWs = ThisWorkbook.Worksheets.Add

    Dim lastRow As Long
    lastRow = SourceWs.Cells(1, 1).SpecialCells(xlCellTypeVisible).End(xlDown).Row

    SourceWs.Range("H1:H" & lastRow).SpecialCells(xlCellTypeVisible).Copy
    DestinationWs.Range("A1").PasteSpecial xlPasteValues

    SourceWs.Range("E1:E" & lastRow).SpecialCells(xlCellTypeVisible).Copy
    DestinationWs.Range("B1").PasteSpecial xlPasteValues
End Sub
Vityata
3#
Vityata Reply to 2018-02-14 13:36:02Z

To define whether a cell is visible or not, both its column and row should be visible. This means, that the .Hidden property of the column and the row should be set to False.

Here is some sample code of how to copy only the visible ranges between two worksheets.

Imagine that you have an input like this in Worksheets(1):

Then you manually hide column B and you want to get in Worksheets(2) every cell from the Range(A1:C4), without the ones in column B. Like this:

To do this, you should check each cell in the range, whether its column or row is visible or not. A possible solution is this one:

Sub TestMe()

    Dim myCell  As Range
    For Each myCell In Worksheets(1).Range("A1:C4")
        If (Not Rows(myCell.Row).Hidden) And (Not Columns(myCell.Column).Hidden) Then
            Dim newCell As Range
            Set newCell = Worksheets(2).Cells(myCell.Row, myCell.Column)
            newCell.Value2 = myCell.Value2
        End If
    Next myCell    
End Sub

Just a general advise - whenever you use something like this Range("A1").Value2 = Range("A1").Value2 make sure that both are the same and not the left is Value2 and the right is .Value. It probably will not bring what you are expecting.

Jeeped
4#
Jeeped Reply to 2018-02-14 14:09:30Z

You cannot perform a direct value transfer without cycling though the areas of the SpecialCells(xlCellTypeVisible) collection.

Sometimes it is easier to copy everything and get rid of what you don't want.

Sub Importe()
    Dim lr As Long

    Worksheets("Sheet1").Copy after:=Worksheets("Sheet1")
    With ActiveSheet
        .Name = "xyz"
        .Cells(1, 1).CurrentRegion = .Cells(1, 1).CurrentRegion.Value2
        For lr = .Cells(.Rows.Count, "A").End(xlUp).Row To 1 Step -1
            If .Cells(lr, "A").EntireRow.Hidden Then
                .Cells(lr, "A").EntireRow.Delete
            End If
        Next lr
        lr = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Cells(1, 1).CurrentRegion.Resize(lr, 1) = .Cells(1, 1).CurrentRegion.Resize(lr, 1).Offset(0, 7).Value2
        .Cells(1, 1).CurrentRegion.Offset(0, 1).Resize(lr, 1) = .Cells(1, 1).CurrentRegion.Resize(lr, 1).Offset(0, 4).Value2
        .Columns("C:XFD").EntireColumn.Delete
    End With

End Sub
DisplayName
5#
DisplayName Reply to 2018-02-14 15:07:47Z

just to throw in an alternative version:

Sub Importe()
    Dim sht1Rng As Range, sht1VisibleRng As Range

    With Worksheets("Sheet1")
        Set sht1Rng = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
    End With
    Set sht1VisibleRng = sht1Rng.SpecialCells(xlCellTypeVisible)

    With Worksheets.Add
        .Range("A1").Resize(sht1Rng.Rows.Count).Value2 = sht1Rng.Offset(, 7).Value2
        .Range("B1").Resize(sht1Rng.Rows.Count).Value2 = sht1Rng.Offset(, 4).Value2
        .UsedRange.EntireRow.Hidden = True
        .Range(sht1VisibleRng.Address(False, False)).EntireRow.Hidden = False
    End With
End Sub

which may have the drawback of Address() maximum "capacity "

You need to login account before you can post.

About| Privacy statement| Terms of Service| Advertising| Contact us| Help| Sitemap|
Processed in 0.392473 second(s) , Gzip On .

© 2016 Powered by mzan.com design MATCHINFO