Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 417
Default Copy and Paste LAST ROW of data: non-contiguous Row, contiguous Column

Assuming the data structure I gave in my previous post, try the following
code:

'----------------------------------------------------------------------
Public Sub SpecialCopyRowAllSheets()
Const MsgBoxTitle = "Special Copy Row of Data"

Dim wsList As Variant
Dim ilngSheet As Long
Dim ws As Worksheet
Dim rngLastCellColA As Range
Dim rngNewRowColA As Range

On Error Resume Next

'Array of sheet names is 0 based. List the sheets you want.
wsList = Array("Sheet1", "Sheet3")

For ilngSheet = LBound(wsList) To UBound(wsList)
Set ws = ActiveWorkbook.Worksheets(wsList(ilngSheet))
If ws Is Nothing _
Then
MsgBox "Worksheet '" & wsList(ilngSheet) & "'" & vbNewLine & _
"does not exist in this workbook.", _
vbCritical + vbOKOnly, _
MsgBoxTitle
Else
Set rngLastCellColA = FindLastCellColA(ws)
If rngLastCellColA Is Nothing _
Then
MsgBox "Worksheet data on sheet 'Sheet1'" & vbNewLine & _
"does not fit the expected pattern." & vbNewLine & _
"Cannot copy data.", _
vbExclamation + vbOKOnly, _
MsgBoxTitle
Else
With ws.UsedRange
Set rngNewRowColA = ws.Cells(.Row + .Rows.Count, 1)
End With

'Copy row of data to new, empty row at the bottom.
rngLastCellColA.EntireRow.Copy Destination:=rngNewRowColA
End If
End If
Set ws = Nothing 'Required, in case next sheet does not exist.
Next ilngSheet
End Sub

'----------------------------------------------------------------------
Private Function FindLastCellColA(ws As Worksheet) As Range
Dim rngCellA1 As Range
Dim rngUsedRange As Range
Dim rngLastCellColA As Range

Set rngCellA1 = ws.Range("A1")
Set rngUsedRange = ws.UsedRange

'Find last cell of contiguous data in Column $A.
If IsEmpty(rngCellA1) _
Then
'Do Ctrl+Down twice to reach the last row of contiguous data.
Set rngLastCellColA = rngCellA1.End(xlDown).End(xlDown)
Else
'Do Ctrl+Down only once to reach the last row of contiguous data.
Set rngLastCellColA = rngCellA1.End(xlDown)
End If

If Intersect(rngLastCellColA, rngUsedRange) = rngLastCellColA _
Then
Set FindLastCellColA = rngLastCellColA
Else
Set FindLastCellColA = Nothing
End If
End Function

--
Regards,
Bill Renaud



Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Copy and Paste LAST ROW of data non-contiguous Sam via OfficeKB.com Excel Programming 6 October 29th 07 02:28 PM
xldown in a non-contiguous column David Gerstman Excel Programming 7 November 8th 06 05:25 PM
Paste Data into Contiguous (Visible) Cells trev_sk8r New Users to Excel 1 June 16th 06 10:04 PM
add all contiguous numbers-column-row Bernard Liengme New Users to Excel 0 May 2nd 06 02:02 PM
copy formulas from a contiguous range to a safe place and copy them back later Lucas Budlong Excel Programming 2 February 22nd 06 08:26 PM


All times are GMT +1. The time now is 03:52 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"