VBA Code for copy and paste entire row to another sheet

[caos88]

Good morning all,

I have data on 1 sheet that i want to copy and paste (clearing the data ) to another sheet. I wish to connect this macro to a "form control button" so when the operator is filling up the form, he clicks on the button for storage and the data will be moved. So far i have the current code for cut and paste which works well. Any suggestions on how to modify it? in the case below, the code works when triggered from the word "Closed" and i don't really need it now. Thank you.

Sub Store()
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet


    ' Change worksheet designations as needed
    Set Source = ActiveWorkbook.Worksheets("Sheet1")
    Set Target = ActiveWorkbook.Worksheets("Sheet2")


    j = Target.Range("A" & Rows.Count).End(xlUp).Row + 1     ' Start copying 1 down from the last row on sheet
    For Each c In Source.Range("A1:K1000")   ' Do 1000 rows
        If c = "Closed" Then
           Source.Rows(c.Row).Copy Target.Rows(j)
           Source.Rows(c.Row).Cut Target.Rows(j)
           j = j + 1
      
        End If
    Next c
End Sub

 

[jolivanes]

This assumes that you have a header that is not to be copied

Sub Maybe_1()
With ActiveSheet
    With .Cells(1, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count).Offset(1)
        .Copy Sheets("final sheet").Cells(Rows.Count, 1).End(xlUp).Offset(1)
        .ClearContents
    End With
End With
End Sub

Copies the whole sheet.

Sub Maybe_2()
    With ActiveSheet.UsedRange
        .Copy Sheets("final sheet").Cells(Rows.Count, 1).End(xlUp).Offset(1)
        .ClearContents
    End With
End Sub

You do mention "for all the rows filled with data"
Does that mean that there could be empty rows in your data range or are all the filled rows contiguous?

 

[jolivanes]

Double

 

[caos88]

This assumes that you have a header that is not to be copied

Sub Maybe_1()
With ActiveSheet
    With .Cells(1, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count).Offset(1)
        .Copy Sheets("final sheet").Cells(Rows.Count, 1).End(xlUp).Offset(1)
        .ClearContents
    End With
End With
End Sub

Copies the whole sheet.

Sub Maybe_2()
    With ActiveSheet.UsedRange
        .Copy Sheets("final sheet").Cells(Rows.Count, 1).End(xlUp).Offset(1)
        .ClearContents
    End With
End Sub

You do mention "for all the rows filled with data"
Does that mean that there could be empty rows in your data range or are all the filled rows contiguous?

sorry for the misunderstanding and yes, there might be rows without data that doesn't copy

 

[caos88]

Double

Thank you. all the above rows are working fine, however, do you think there is any way to copy rows except blank ones?

 

[jolivanes]

I guess you don't read posts. I am referring to Post #9, last sentence.

 

[jolivanes]

This assumes that when a cell in Column A is empty that the whole row is empty

Sub Maybe_3()
Application.ScreenUpdating = False
    With ActiveSheet
        .UsedRange.Columns(1).SpecialCells(4).EntireRow.Delete
        .UsedRange.SpecialCells(2).Copy Sheets("final sheet").Cells(Rows.Count, 1).End(xlUp).Offset(1)
        .UsedRange.ClearContents
    End With
Application.ScreenUpdating = True
End Sub

If the Cell in Column A is empty but other cells have data.

Sub Maybe_4()
Dim lr As Long, lc As Long, i As Long
lr = Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
lc = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
For i = 2 To lr    '<---- Start at Row2. Change as required
If Not Application.CountA(Rows(i)) = 0 Then
Cells(i, 1).Resize(, lc).Copy Sheets("final sheet").Cells(Sheets("final sheet").Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row, 1).Offset(1)
End If
Next i
ActiveSheet.Cells(1, 1).Resize(lr, lc).ClearContents    '<---- Change (1, 1) to (2, 1) to keep header
End Sub

How many rows max are we talking about that need to be copied and pasted?

 

[caos88]

This assumes that when a cell in Column A is empty that the whole row is empty

Sub Maybe_3()
Application.ScreenUpdating = False
    With ActiveSheet
        .UsedRange.Columns(1).SpecialCells(4).EntireRow.Delete
        .UsedRange.SpecialCells(2).Copy Sheets("final sheet").Cells(Rows.Count, 1).End(xlUp).Offset(1)
        .UsedRange.ClearContents
    End With
Application.ScreenUpdating = True
End Sub

If the Cell in Column A is empty but other cells have data.

Sub Maybe_4()
Dim lr As Long, lc As Long, i As Long
lr = Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
lc = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
For i = 2 To lr    '<---- Start at Row2. Change as required
If Not Application.CountA(Rows(i)) = 0 Then
Cells(i, 1).Resize(, lc).Copy Sheets("final sheet").Cells(Sheets("final sheet").Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row, 1).Offset(1)
End If
Next i
ActiveSheet.Cells(1, 1).Resize(lr, lc).ClearContents    '<---- Change (1, 1) to (2, 1) to keep header
End Sub

How many rows max are we talking about that need to be copied and pasted?

Thank you, it's what I was looking for