locked
vba cell - copy cell range to another sheet RRS feed

  • Question

  • I have the following vba code.  it loops until a blank.

    I have two issues with the following code:

    1) there are 46 rows,  and 2 rows have blanks, before the 46th row.  Is there a better way to end the loop, other than Blank.

    2)  my biggest issue:   when the rows are copied  they do not copy the data formats,  mainly the Cell Height and Width.  

    X = 14
    Do While Cells(X, 11) <> ""
    Worksheets("Sheet1").Range(Cells(X, 11), Cells(X, 19)).Copy
    Worksheets("Sheet2").Activate
    eRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    ActiveSheet.Paste Destination:=Worksheets("Sheet2").Rows(eRow)
    Worksheets("Sheet1").Activate
    X = X + 1
    Loop

    Thank you for your help

    
    Friday, May 9, 2014 1:48 AM

Answers

  • Re:  copying data

    Sub AnotherWay()
     Dim eRow As Long
     Dim N As Long
     Dim R As Long

     'Find last row
     With Worksheets("Sheet2")
       eRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
     End With

     With Worksheets("Sheet1")
     'Copy and paste
      .Range(.Cells(14, 11), .Cells(59, 19)).Copy Destination:=Worksheets("Sheet2").Rows(eRow)
     'Make column width the same
       For N = 11 To 19
         Worksheets("Sheet2").Columns(N - 10).ColumnWidth = .Columns(N).ColumnWidth
       Next
     'Make row height the same
       For N = 14 To 59
         Worksheets("Sheet2").Rows(eRow + R).RowHeight = .Rows(N).RowHeight
         R = R + 1
       Next
     End With
    End Sub
    '---
    Jim Cone
    Portland, Oregon USA
    free & commercial excel stuff
    https://goo.gl/IUQUN2
     (Dropbox)




    • Marked as answer by Semperfi4000 Saturday, May 10, 2014 5:43 PM
    • Edited by James Cone Tuesday, October 18, 2016 5:03 PM
    Friday, May 9, 2014 3:51 AM