View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Bill Renaud Bill Renaud is offline
external usenet poster
 
Posts: 417
Default Copy specific cells to new rows

Try the following code. Note: If Sheet2 is empty, it will copy to row 2,
however.

Public Sub CopyCells()
Dim wb As Workbook
Dim ws1 As Worksheet 'Source worksheet for data to copy.
Dim ws2 As Worksheet 'Destination worksheet.

Dim rngName As Range 'Named ranges.
Dim rngDate As Range
Dim rngCompany As Range
Dim rngState As Range

Dim lngNextAvailableRow As Long

Set wb = ActiveWorkbook
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

With wb
Set rngName = .Names("Name").RefersToRange
Set rngDate = .Names("Date").RefersToRange
Set rngCompany = .Names("Company").RefersToRange
Set rngState = .Names("State").RefersToRange
End With

With ws2
With .UsedRange
lngNextAvailableRow = .Row + .Rows.Count
End With
'Now copy cells.
.Cells(lngNextAvailableRow, 1).Value = rngName.Value
.Cells(lngNextAvailableRow, 2).Value = rngDate.Value
.Cells(lngNextAvailableRow, 3).Value = rngCompany.Value
.Cells(lngNextAvailableRow, 4).Value = rngState.Value
End With
End Sub


--
Regards,
Bill Renaud