We help IT Professionals succeed at work.

Copy a row

142 Views
Last Modified: 2016-10-24
I need to be able to copy a row from sheet 1 to sheet 2 and remove the row from sheet 1. If a cell in AB is true the entire row needs to be copied once a button is pressed.
Comment
Watch Question

Subodh Tiwari (Neeraj)Excel & VBA Expert
CERTIFIED EXPERT
Most Valuable Expert 2018
Awarded 2015

Commented:
Please try this.....
Sub CopyRow()
Dim sws As Worksheet, dws As Worksheet
Dim lr As Long
Application.ScreenUpdating = False
Set sws = Sheets("Sheet1")
Set dws = Sheets("Sheet2")
lr = sws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
With sws.Range("AB1:AB" & lr)
   .AutoFilter field:=1, Criteria1:="True"
   If .SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
      sws.Range("AB2:AB" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Copy dws.Range("A" & Rows.Count).End(3)(2)
      sws.Range("AB2:AB" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Delete
   End If
   .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

Open in new window

Author

Commented:
That's great but I am confused why there is an error with line 11.

Also I have renamed sheet one blueteq

Any ideas
Subodh Tiwari (Neeraj)Excel & VBA Expert
CERTIFIED EXPERT
Most Valuable Expert 2018
Awarded 2015

Commented:
What error you get?
It's hard to tell unless you upload a sample workbook. I assume sheet2 doesn't contain merged cells.

Author

Commented:
Hi
That's no problem I have attached a copy of the spreadsheet.
Thank you so much for your assistance.

Author

Commented:
Sorry here its is
Blueteqemail-v1.xlsm
Subodh Tiwari (Neeraj)Excel & VBA Expert
CERTIFIED EXPERT
Most Valuable Expert 2018
Awarded 2015

Commented:
Okay try this....
Sub CopyRow()
Dim sws As Worksheet, dws As Worksheet
Dim lr As Long
Application.EnableEvents = False
Application.ScreenUpdating = False
Set sws = Sheets("Blueteq")
Set dws = Sheets("Sheet2")
lr = sws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
With sws.Range("AB5:AB" & lr)
   .AutoFilter field:=1, Criteria1:="True"
   If .SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
      sws.Range("AB6:AB" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Copy dws.Range("A" & Rows.Count).End(3)(2)
      sws.Range("AB6:AB" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Delete
   End If
   .AutoFilter
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Open in new window

Subodh Tiwari (Neeraj)Excel & VBA Expert
CERTIFIED EXPERT
Most Valuable Expert 2018
Awarded 2015

Commented:
Either you clear the filter from Row4 before running the code or try the tweaked code...
Sub CopyRow()
Dim sws As Worksheet, dws As Worksheet
Dim lr As Long
Application.EnableEvents = False
Application.ScreenUpdating = False
Set sws = Sheets("Blueteq")
Set dws = Sheets("Sheet2")
lr = sws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
sws.AutoFilterMode = False
With sws.Range("AB5:AB" & lr)
   .AutoFilter field:=1, Criteria1:="True"
   If .SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
      sws.Range("AB6:AB" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Copy dws.Range("A" & Rows.Count).End(3)(2)
      sws.Range("AB6:AB" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Delete
   End If
   .AutoFilter
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Open in new window

Author

Commented:
That's fantastic thank you
Subodh Tiwari (Neeraj)Excel & VBA Expert
CERTIFIED EXPERT
Most Valuable Expert 2018
Awarded 2015

Commented:
You're welcome Sam! Glad to help.

Author

Commented:
Great solution but it is causing Excel to crash any ideas ?
Excel & VBA Expert
CERTIFIED EXPERT
Most Valuable Expert 2018
Awarded 2015
Commented:
This one is on us!
(Get your first solution completely free - no credit card required)
UNLOCK SOLUTION

Author

Commented:
Fantastic thank you
Unlock the solution to this question.
Join our community and discover your potential

Experts Exchange is the only place where you can interact directly with leading experts in the technology field. Become a member today and access the collective knowledge of thousands of technology experts.

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.