1

I need to copy paste big sheets, this is taking a lots of time. I have been advised not to use .copy process on worksheets but rather proceeds cell by cell. Giving new cells each properties of the ancient cell. This is what I do here: Saving only some sheets in another Workbook.

To do it cells by cells I need to know the last cell containing information. (not only value, but colour, borders... etc). I've seen many simple solution on internet, but they all have a problem.

ActiveSheet.UsedRange.Rows.Count often gives too many values... I got a 810 * 16000 answer for a 5 * 18 table

range("A" & activesheet.rows.count).end(xlup).row works only for the first columns...

What would be the best way to procedd to final the real last line with value ? containig information (value, colour, border...)

3
  • 3
    stackoverflow.com/questions/11169445/… Commented May 3, 2013 at 13:13
  • It works only for one columns and I have the feeling that a loop over columns would be inelegant. Commented Jul 11, 2013 at 15:14
  • What do you mean? The above code will give you the last row which has data. Or have I misunderstood your question? Commented Jul 11, 2013 at 16:50

3 Answers 3

3

This command in Excel 2010 ActiveCell.SpecialCells(xlLastCell).Select will move the cursor (active cell) to the last one that had a non-trivial value, even if the cell currently is blank

This command Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select will select all cells from the current to the last one that had a non-trivial value.

Sign up to request clarification or add additional context in comments.

Comments

2

Both these approaches work for me for getting the last cell 2007. I have used the "UsedRange" method in Excel 2003 as well.

If they do not work for you then your spreadsheet may have something in it that Excel is not showing you. This has happened to me before. The fix would be to select every empty row below your real data and right-Click->Delete them (Same with columns to the right).

Shortcut to delete rows: Shift+Space, Shift+Control+DownArrow, Rightclick->Delete

Shortcut to delete columns: Control+Space, Shift+Control+RightArrow, Rightclick->Delete

examples:

set lastCell = ActiveCell.SpecialCells(xlLastCell) 

or

Set lastCell = worksheetObj.UsedRange.Item(worksheetObj.UsedRange.Cells.Count) 

1 Comment

thanks for the answer, is there any way to select only cells with a visible property ? for exemple, I don't care if a cell is in bold font but has no value
0

Save the Following code to a class file name FinalRowLocator

Public Property Get FinalRow(Optional ByVal Col As String, Optional ByVal Min As Boolean) As Long FinalRow = pFinalRow(Col, Min) End Property Public Property Get Verify(Optional ByVal Col As String, Optional ByVal Min As Boolean) As Long Verify = pVerify(Col, Min) End Property Private Function pVerify(Optional ByVal Col As String, Optional ByVal Min As Boolean) As Long Dim i As Long Dim j As Long Dim rVerify As Long Dim Votes(1 To 5) As Byte Dim Congress(1 To 5) As Long Dim FRL As New FinalRowLocator Congress(1) = FRL.Columbus Congress(2) = FRL.GosEgg Congress(3) = FRL.OldTimer Congress(4) = FRL.RainMan Congress(5) = FRL.Slacker For i = 1 To 5 For j = 1 To 5 If Congress(i) = Congress(j) Then Votes(i) = Votes(i) + 1 Next j Next i For i = 1 To 5 If rVerify < Congress(i) Then rVerify = i Next i pVerify = Congress(rVerify) End Function Public Property Get GosEgg(Optional ByVal Col As String) As Long GosEgg = pFinalRow_M1(Col) End Property Public Property Get RainMan(Optional ByVal Col As String) As Long RainMan = pFinalRow_M2(Col) End Property 'Public Property Get MathIt() As Long ' MathIt = pFinalRow_M3 'End Property Public Property Get OldTimer() As Long OldTimer = pFinalRow_M4 End Property Public Property Get Columbus() As Long Columbus = pFinalRow_M5 End Property Public Property Get Slacker(Optional ByVal Col As Long) As Long Slacker = pFinalRow_M6(Col) End Property Private Function pFinalRow(Optional ByVal Col As String, Optional ByVal Min As Boolean) As Long Dim FinalRow As Long Select Case Col Case Is = "" Select Case Min Case False If pFinalRow_M1 > pFinalRow_M2 Then FinalRow = pFinalRow_M1 If pFinalRow_M1 < pFinalRow_M2 Then FinalRow = pFinalRow_M2 'If pFinalRow_M3 > FinalRow Then FinalRow = pFinalRow_M3 If pFinalRow_M5 > FinalRow Then FinalRow = pFinalRow_M5 If pFinalRow_M6 > FinalRow Then FinalRow = pFinalRow_M6 Case True If pFinalRow_M1 < pFinalRow_M2 Then FinalRow = pFinalRow_M1 If pFinalRow_M1 > pFinalRow_M2 Then FinalRow = pFinalRow_M2 'If pFinalRow_M3 < FinalRow Then FinalRow = pFinalRow_M3 If pFinalRow_M5 < FinalRow Then FinalRow = pFinalRow_M5 If pFinalRow_M6 < FinalRow Then FinalRow = pFinalRow_M6 End Select Case Is <> 0 Select Case Min Case False If pFinalRow_M1(Col) > FinalRow Then FinalRow = pFinalRow_M1(Col) If pFinalRow_M2(Col) > FinalRow Then FinalRow = pFinalRow_M2(Col) Case True If pFinalRow_M1(Col) < FinalRow Then FinalRow = pFinalRow_M1(Col) If pFinalRow_M2(Col) < FinalRow Then FinalRow = pFinalRow_M2(Col) End Select End Select 'If pFinalRow_M4 > FinalRow Then FinalRow = pFinalRow_M4 'Disabled, lags behind. pFinalRow = FinalRow End Function Private Function pFinalRow_M1(Optional ByRef ColLtr As String) As Long If ColLtr = "" Then ColLtr = "A" pFinalRow_M1 = Range(ColLtr & "65536").End(xlUp).Row End Function Private Function pFinalRow_M2(Optional ByRef Col As String) As Long Dim i As Byte Dim FinalRow As Long Select Case Col Case Is = "" For i = 1 To 26 If FinalRow < Cells(ActiveSheet.Rows.Count, i).End(xlUp).Row Then FinalRow = Cells(ActiveSheet.Rows.Count, i).End(xlUp).Row Next i Case Is <> "" FinalRow = Cells(ActiveSheet.Rows.Count, Col).End(xlUp).Row End Select pFinalRow_M2 = FinalRow End Function Private Function pFinalRow_M3() As Long Dim FinalRow As Long Dim ASUC As Long ASUC = ActiveSheet.UsedRange.Count FinalRow = ASUC / pFinalRow_M2 pFinalRow_M3 = FinalRow End Function Private Function pFinalRow_M4() As Long 'Works on unmodified (saved) sheet only. Selection.SpecialCells(xlCellTypeLastCell).Select pFinalRow_M4 = ActiveCell.Row End Function Private Function pFinalRow_M5() As Long On Error GoTo ErrorHandler 'May have problems with hidden rows 'This Method returns 0 on a sheet with no data while the others return 1 pFinalRow_M5 = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row Exit Function ErrorHandler: Select Case Err.Number Case 91 'Assume Error is due to no data, return 0 pFinalRow_M5 = 0 Resume Next Case Else On Error GoTo 0 End Select End Function Private Function pFinalRow_M6(Optional ByRef ColLtr As Long) As Long If ColLtr <= 0 Then ColLtr = 1 pFinalRow_M6 = Sheets(ActiveSheet.Name).Cells(Rows.Count, ColLtr).End(xlUp).Row End Function Public Function Diagnostics_Run() Dim FRL As New FinalRowLocator MsgBox "Columbus: " & FRL.Columbus & Chr(13) _ & "FinalRow: " & FRL.FinalRow & Chr(13) _ & "GosEgg: " & FRL.GosEgg & Chr(13) _ & "OldTimer: " & FRL.OldTimer & Chr(13) _ & "RainMan: " & FRL.RainMan & Chr(13) _ & "Slacker: " & FRL.Slacker '& _ ' _ & "MathIt: " & FRL.MathIt & Chr(13) End Function Public Property Get DoubleCheck(ByVal Result1 As Long, ByVal Result2 As Long) As Boolean If Result1 <> Result2 Then DoubleCheck = False If Result1 = Result2 Then DoubleCheck = True End Property Private Property Get pPara() Dim FRL As New FinalRowLocator pPara = FRL.FinalRow(, Not FRL.DoubleCheck(FRL.FinalRow, FRL.Verify)) End Property Public Property Get Para() Para = pPara End Property 

then:

Dim FLR as new FinalRowLocator Dim FinalRow as Long FinalRow = FRL.FinalRow 

Provided you have ascertained the correct finalrow, the following should work.

'This will return the column letter 'This Function is dependant on FinalRow returning the correct value. Dim rInt As Long rInt = ActiveSheet.UsedRange.Count psFinalCol = Chr((rInt / FinalRow) + 64) 
'This will return the column number 'This Function is dependant on FinalRow returning the correct value. Dim rInt As Long rInt = ActiveSheet.UsedRange.Count piFinalCol = rInt / FinalRow 

Additional Usage Information:

Dim FRL as New FinalRowLocator 'Create an instance of the FinalRowLocator Class Dim FinalRow as Long 'Declare the FinalRow Variable as Long FinalRow = FRL.FinalRow 'Gets the Highest Number returned from all methods FinalRow = FRL.FinalRow("", true) 'Returns the lowest number from all methods FinalRow = FLR.FinalRow("A") 'Gets the highest number (column A) returned from methods 1 & 2 FinalRow = FRL.FinalRow("A", true) 'Gets the lowest number (column A) returned from methods 1 & 2 'FRL.DoubleCheck(FRL.FinalRow, FRL.Verify) 'returns true or false based on if the values match FinalRow.Para is the same as FRL.FinalRow(, Not FRL.DoubleCheck(FRL.FinalRow, FRL.Verify)) 'Returns the lowest row number if the highest one can not be verified. 'FRL.Verify Determins the FinalRow in a Democratic Manner. FRL.Diagnostics 'will display the results of each individual method in a msgbox '***** Methods FRL.Columbus 'Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row 'May have problems with hidden rows 'This Method returns 0 on a sheet with no data while the others return 1 FRL.GosEgg 'does not count past 65536 rows [Range(ColLtr & "65536").End(xlUp).Row] FRL.OldTimer 'Selection.SpecialCells(xlCellTypeLastCell).Select [Works on Unmodified Saved Sheet Only] FRL.RainMain 'Cells(ActiveSheet.Rows.Count, Col).End(xlUp).Row FRL.Slacker 'Sheets(ActiveSheet.Name).Cells(Rows.Count, ColLtr).End(xlUp).Row 

Comments

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.