Welcome toVigges Developer Community-Open, Learning,Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
1.2k views
in Technique[技术] by (71.8m points)

excel - Only copy visible range in VBA?

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
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

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

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to Vigges Developer Community for programmer and developer-Open, Learning and Share

2.1m questions

2.1m answers

63 comments

56.6k users

...