Moving Data and delete transferred data.

[Daroh]

Hi, I have a worksheet (Sheet1) with data in each row. I want the data in Sheet1 to be transferred to sheet2 if column 10 (J) equals "Yes", and once transferred/copied to sheet2, the data is deleted from sheet1 and the all the blank rows are deleted. Column 10 value will be either Yes or No. Any help would be great.

Below is a code I am currently using;

Private Sub CommandButton1_Click()
a = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row


For i = 2 To a


If Sheet1.Cells(i, 10).Value = "Yes" Then
Application.ScreenUpdating = False


Sheet1.Rows(i).Copy


Sheet2.Activate


b = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row


Sheet2.Cells(b + 1, 1).Select


ActiveSheet.Paste


Sheet1.Activate


End If


Next






Application.CutCopyMode = Ture


Sheet1.Cells(1, 1).Select


End Sub

 

[Fluff]

How about

Sub Daroh()
   With Sheet1
      If .AutoFilterMode Then .AutoFilterMode = False
      .Range("A1:J1").AutoFilter 10, "yes"
      .AutoFilter.Range.Offset(1).EntireRow.Copy Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1)
      .AutoFilter.Range.Offset(1).EntireRow.Delete
      .AutoFilterMode = False
   End With
End Sub

 

[Daroh]

Thanks Fluff that's what I'm looking for. One other question, what adjustments do I have to make to the code to copy only the first seven columns (Col 1 to 7) the row with yes? and only delete col 1 to 7 of that row.

 

[Fluff]

How about

Sub Daroh()
   Dim Rng As Range
   With Sheet1
      If .AutoFilterMode Then .AutoFilterMode = False
      .Range("A1:J1").AutoFilter 10, "yes"
      Set Rng = Intersect(.AutoFilter.Range.Offset(1), .Range("A:G")).SpecialCells(xlVisible)
      Rng.Copy Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1)
      .AutoFilterMode = False
      Rng.Delete xlShiftUp
   End With
End Sub

 

[Daroh]

Hi Fluff, Thanks for help. It worked perfect. One final question, what do I have to change in the code to only copy A:G from sheet1 to sheet2? and to also delete the range A:J on Sheet1 and move everything up? I just want to copy the values and not formulas. Thanks Darryll.

 

[Fluff]

Try

Sub Daroh()
   Dim Rng As Range, Cl As Range
   With Sheet1
      If .AutoFilterMode Then .AutoFilterMode = False
      .Range("A1:J1").AutoFilter 10, "yes"
      Set Rng = Intersect(.AutoFilter.Range.Offset(1), .Range("A:G")).SpecialCells(xlVisible)
      Rng.Copy
      Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      .AutoFilterMode = False
      For Each Cl In Rng.Areas
         Cl.Resize(, 10).Delete xlShiftUp
      Next Cl
   End With
End Sub

 

[Daroh]

Hi Fluff, thanks for your help. The code works perfect.

I have a formatting question, in Sheet1; column H (Due Date) and column I (Countdown to due date), I want date performed + 7 = Due Date and countdown = Today()-Due Date. I no I can use formulas but, is there a way to auto populate without dragging the cells down?

Once again thank you.

 

[Fluff]

As this is now a totally different question, you need to start a new thread.