Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 93
  • Last Modified:

Copy a row

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.
0
Sam Coombes
Asked:
Sam Coombes
  • 6
  • 6
1 Solution
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
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

0
 
Sam CoombesAuthor 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
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
What error you get?
It's hard to tell unless you upload a sample workbook. I assume sheet2 doesn't contain merged cells.
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
Sam CoombesAuthor Commented:
Hi
That's no problem I have attached a copy of the spreadsheet.
Thank you so much for your assistance.
0
 
Sam CoombesAuthor Commented:
Sorry here its is
Blueteqemail-v1.xlsm
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
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

0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
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

1
 
Sam CoombesAuthor Commented:
That's fantastic thank you
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome Sam! Glad to help.
1
 
Sam CoombesAuthor Commented:
Great solution but it is causing Excel to crash any ideas ?
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
This code has nothing that would cause excel to crash by any means for sure.
Either your file may be corrupt or since you have already have few event codes that might be doing some damage to the formatting etc.
Just copy the data from the current workbook (values only not the formatting etc) to another workbook and run this code as many times as you wish. I am sure that won't cause any problem.
1
 
Sam CoombesAuthor Commented:
Fantastic thank you
0

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

  • 6
  • 6
Tackle projects and never again get stuck behind a technical roadblock.
Join Now