Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Copy and Paste LAST ROW of data non-contiguous | Excel Programming | |||
xldown in a non-contiguous column | Excel Programming | |||
Paste Data into Contiguous (Visible) Cells | New Users to Excel | |||
add all contiguous numbers-column-row | New Users to Excel | |||
copy formulas from a contiguous range to a safe place and copy them back later | Excel Programming |