Copy row to next available row on another sheet

**cindy1971** · 01-13-2009, 12:04 PM

I have the following code. I select a row in sheet one, run the code (which will eventually be attached to a button, but right now, is not], and it moves that row to another sheet. The problem is, it overwrites the code on the other sheet. I want it to either be added to the second sheet on the first available row. Any ideas?

This has to be extremely user friendly. The other people using it know little about Excel, and even less than I do about macros and VBA. Thanks, in advance, for the help!

Sub copyrows()
Dim r As Integer
Dim i As Integer
r = 2
For i = Selection.Rows.Count + 1 To 1 Step -1
If Range("G" & i).Value = "Closed" Then
Range("G" & i).EntireRow.Copy Sheets("done").Cells(r, 1)
Range("G" & i).EntireRow.Delete
r = r + 1
End If
Next
End Sub

**mdbct** · 01-13-2009, 12:44 PM

Try this variation:

Sub copyrows()
    Dim i As Integer
    Application.ScreenUpdating = False
    For i = Selection.Rows.Count + 1 To 1 Step -1
        If Range("G" & i).Value = "Closed" Then
            Range("G" & i).EntireRow.Copy
            Worksheets("done").Paste Destination:=Worksheets("done").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
            Range("G" & i).EntireRow.Delete
        End If
    Next
    Application.ScreenUpdating = True
End Sub

**mdbct** · 01-13-2009, 12:48 PM

or using your same structure:

Sub copyrows()
    Dim i As Integer
    Application.ScreenUpdating = False
    For i = Selection.Rows.Count + 1 To 1 Step -1
        If Range("G" & i).Value = "Closed" Then
            Range("G" & i).EntireRow.Copy Sheets("done").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
            Range("G" & i).EntireRow.Delete
        End If
    Next
    Application.ScreenUpdating = True
End Sub

**cindy1971** · 01-13-2009, 12:50 PM

Thanks so much - you're my hero!!

**Leith Ross** · 01-13-2009, 01:05 PM

Hello cindy1971,

Here is another method.

Sub CopyAndDeleteRow()

  Dim DstWks As Worksheet
  Dim LastCell As Range
  Dim LastRow As Long
  Dim I As Long
  Dim NextRow As Long
  Dim R As Long
  Dim Rng As Range
  Dim StartRow As Long
  
    StartRow = 1
    Set Rng = Selection
    Set DstWks = Worksheets("Done")
    
    With DstWks.UsedRange
      Set LastCell = .Find(What:="*", _
                           After:=.Cells(1, 1), _
                           LookAt:=xlWhole, _
                           LookIn:=xlFormulas, _
                           SearchOrder:=xlByRows, _
                           SearchDirection:=xlPrevious, _
                           MatchCase:=False)
      LastRow = LastCell.Row
      NextRow = IIf(LastRow < StartRow, StartRow, LastRow + 1)
    End With
  
      For I = Rng.Rows.Count To 1 Step -1
        If Cells(Rng.Rows(I).Row, "G") = "Closed" Then
           Rng.Rows(I).EntireRow.Copy DstWks.Row(LastRow + R)
           Rng.Rows(I).Delete
           R = R + 1
        End If
      Next I
      
End Sub

Sincerely,
Leith Ross

Thread: Copy row to next available row on another sheet

Thread Tools

Display

Copy row to next available row on another sheet

Thanks!

Thread Information

Users Browsing this Thread

Tags for this Thread

Bookmarks

Bookmarks

Posting Permissions