Copy entire row based on condition-i have the code-help plz

[lundbhaiz]

Sub CondCopy()


    ThisWorkbook.Activate
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "MySheet"


    Sheets("JCR").Select
    Rows(1).Copy
    
    Sheets("MySheet").Activate
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Font.Bold = True
    
    Application.CutCopyMode = False
        
    Sheets("JCR").Select
    RowCount = Cells(Cells.Rows.Count, "A").End(xlUp).Row
    For i = 1 To RowCount
    
        Range("A" & i).Select
        Check_value = ActiveCell
        If Check_value <> 0 Then
            ActiveCell.EntireRow.Copy
            Sheets("MySheet").Select
            RowCount = Cells(Cells.Rows.Count, "A").End(xlUp).Row
            Range("A" & RowCount + 1).Select
            ActiveSheet.Paste
            Sheets("MySheet").Select
        End If
    Next
End Sub

hi. this is my code. i want to copy entire row to sheet called "MySheet" from sheet "JCR". the copy entire row is base on a condition that if the cell value in column A is not equal to zero then copy entire row and paste it in "MySheet" from row 2. I make this code and run this code and it goes into infinite loop. plz some help me because i cannot see and understand what and where is it going wrong.

 

[lundbhaiz]

can some help me please ? why no one helps me ?

 

[JMonty]

I will give it a go. First things first, though.

You want to copy an entire row from JCR to Row 2 of Mysheet if the A column of that specific row is not equal to zero, am I correct? This is just to clarify. I read your code and I know what it does but I need to be sure myself.

 

[JMonty]

Try this one. Just something I put together really quickly.

Sub CondCopy()Dim wbk As Workbook
Dim wjcr As Worksheet
Dim lrow As Range
Dim i As Long
Dim j As Long


Set wbk = Application.ThisWorkbook
Set wjcr = wbk.Worksheets("JCR")


wbk.Add(After:=Worksheets(Worksheet.Count)).Name = "MySheet"
Dim wmys As Worksheet
Set wmys = wbk.Worksheets("Mysheet")


j = wjcr.Cells(Rows.Count, 1).End(xlUp).Row


For i = 1 To j
    If wjcr.Range("A" & i).Value <> 0 Then
        Set lrow = wmys.Cells(Rows.Count, 1).End(xlUp).Offset(1)
        wjcr.Range("A" & i).EntireRow.Copy
        lrow.PasteSpecial
    End If
Next i


End Sub

Please test it on a copy of your workbook and let us know of the results. This will further help everyone.

 

[lundbhaiz]

thanks you man.

the code give debug error on this line:

wbk.Add(After:=Worksheets(Worksheet.Count)).Name = "MySheet"​

 

[JMonty]

This should do it. Added some error handling as well.

Sub CondCopy()
Dim wbk As Workbook
Dim wjcr As Worksheet
Dim lrow As Range
Dim i As Long
Dim j As Long

Set wbk = Application.ThisWorkbook
Set wjcr = wbk.Worksheets("JCR")

On Error GoTo errHandle:
wbk.Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "MySheet"
Dim wmys As Worksheet
Set wmys = wbk.Worksheets("Mysheet")

j = wjcr.Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To j
    If wjcr.Range("A" & i).Value <> 0 Then
        Set lrow = wmys.Cells(Rows.Count, 1).End(xlUp).Offset(1)
        wjcr.Range("A" & i).EntireRow.Copy
        lrow.PasteSpecial
    End If
Next i

Exit Sub

errHandle:
    Select Case Err.Number
        Case 9
            MsgBox "There's no sheet with that name!", vbOKOnly, _
                "Source does not exist!"
        Case 1004
            MsgBox "That sheet already exists!", vbOKOnly, _
                "Check your sheets!"
        Case Else
            Resume Next
    End Select
    
End Sub

Let us know if this works. This will also help everyone else.

 

[lundbhaiz]

ok I replace the line with debug error with this one and the macro run smooth:

Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "MySheet"​

ok now is it possible to do this for 3 sheets together instead of the one called "JCR" ? thanks you for kind help dear.

 

[JMonty]

Your request is a little vague. How would the 3 sheets together work? Do I copy from three sheets to MySheet, is that it?

 

[lundbhaiz]

This should do it. Added some error handling as well.

Sub CondCopy()
Dim wbk As Workbook
Dim wjcr As Worksheet
Dim lrow As Range
Dim i As Long
Dim j As Long

Set wbk = Application.ThisWorkbook
Set wjcr = wbk.Worksheets("JCR")

On Error GoTo errHandle:
wbk.Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "MySheet"
Dim wmys As Worksheet
Set wmys = wbk.Worksheets("Mysheet")

j = wjcr.Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To j
    If wjcr.Range("A" & i).Value <> 0 Then
        Set lrow = wmys.Cells(Rows.Count, 1).End(xlUp).Offset(1)
        wjcr.Range("A" & i).EntireRow.Copy
        lrow.PasteSpecial
    End If
Next i

Exit Sub

errHandle:
    Select Case Err.Number
        Case 9
            MsgBox "There's no sheet with that name!", vbOKOnly, _
                "Source does not exist!"
        Case 1004
            MsgBox "That sheet already exists!", vbOKOnly, _
                "Check your sheets!"
        Case Else
            Resume Next
    End Select
    
End Sub

Let us know if this works. This will also help everyone else.

Ok this work good too. why did it give me debug in first code ? Ok but the problem now solved so no issue. plz let me know if it possible to run this code for 3 worksheets together ? thanks you very very much for you solved my problem dear. realy appreciated the help.

 

[JMonty]

Again, it's a little vague. By worksheet, do you mean 3 different files or 3 different sheets in one file? Either way, yes, it could work. But you need to answer my question first so that we can adjust it accordingly.

As to your question, the debug error on the first part is a code error. I wasn't using Excel when I was fixing your code so I just copied your original lines and used my own technique on it. When you said it gave an error, that's when I started using Excel to check my syntax.

The error handling part is important for two reasons: error 9 happens when there is no reference sheet ("JCR"). Error 1004 happens when there's already the target sheet ("MySheet"). I had to put them in so that there are no problems in any case you run the macro and one of the two cases above is true.