Copy entire row if CountA <>0 to another sheet

jolivanes

Well-known Member
Joined
Sep 5, 2004
Messages
1,504
If you would take some time and explain exactly what needs to happen when a certain condition is true, that would help.
Sorting through a code that does not make sense and doesn't work, as in your first post, is not the way to go.
 

Some videos you may like

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
38,993
Office Version
365
Platform
Windows
How about
VBA Code:
Sub HarshilMehta()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long, cc As Long
   
   With Sheets(3)
      Ary = .Range("A6:AM" & .Range("D" & Rows.Count).End(xlUp).Row).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To UBound(Ary, 2))
   For r = 1 To UBound(Ary)
      For c = 10 To UBound(Ary, 2)
         If Ary(r, c) <> "" Then
            nr = nr + 1
            For cc = 1 To UBound(Ary, 2)
               Nary(nr, cc) = Ary(r, cc)
            Next cc
            Exit For
         End If
      Next c
   Next r
   Sheets(1).Range("A1").Resize(nr, UBound(Ary, 2)).Value = Nary
End Sub
 

Harshil Mehta

New Member
Joined
May 14, 2020
Messages
19
Office Version
2013
Platform
Windows
Hi,
Here's a change I've done. Now the date is copied from sheet(3) range A:AM and paste to sheet(1) to column D on (horizontally),. Is that what you need or you want or data fom A:AM pasted in column D only?

VBA Code:
Sub ABC()
Dim LastRow&
Dim newRow&
Dim strRange$
LastRow= Sheets(3).Cells(Rows.Count, "d").End(xlUp).Row

newRow=1

For i = 7 To LastRow
    strRange =CStr ("J" & i & ":AM" & i)
    If WorksheetFunction.CountA(RANGE(strRange)) <> 0 Then
        newRow=newRow+1
        Sheets(3).Range(Cells(i,"A"),Cells(i,"AM")).Copy     Sheets(1).Cells(newRow,"D")
    End If
Next

MsgBox "Done"

End Sub
No. Instead of copying the entire row the code should copy rangeA:AM till the last row in column D of sheet3 if the condition is met and paste it in sheet1 one below the other
 

Harshil Mehta

New Member
Joined
May 14, 2020
Messages
19
Office Version
2013
Platform
Windows
No. Instead of copying the entire row the code should copy rangeA:AM till the last row in column D of sheet3 if the condition is met and paste it in sheet1 one below the other
I want to sort the data in such a way if the range J:AM of sheet3 are blank then move down and paste rangeA:AM of sheet3 to sheet1

Before:
idnameRange J:M
1234abcUSAAmericasUSAAmericasUSAAmericas
4567gha
7894tyftaUSAAmericasUSAAmericasUSAAmericas
9516hgftysUSAAmericasUSAAmericasUSAAmericas


After:
idnameRange J:M
1234abcUSAAmericasUSAAmericasUSAAmericas
7894tyftaUSAAmericasUSAAmericasUSAAmericas
9516hgftysUSAAmericasUSAAmericasUSAAmericas
4567gha
 

Harshil Mehta

New Member
Joined
May 14, 2020
Messages
19
Office Version
2013
Platform
Windows
If you would take some time and explain exactly what needs to happen when a certain condition is true, that would help.
Sorting through a code that does not make sense and doesn't work, as in your first post, is not the way to go.
I want to sort the data in such a way if the range J:AM of sheet3 are blank then move down and paste rangeA:AM of sheet3 to sheet1

Before:
idnameRange J:M
1234abcUSAAmericasUSAAmericasUSAAmericas
4567gha
7894tyftaUSAAmericasUSAAmericasUSAAmericas
9516hgftysUSAAmericasUSAAmericasUSAAmericas


After:

idnameRange J:M
1234abcUSAAmericasUSAAmericasUSAAmericas
7894tyftaUSAAmericasUSAAmericasUSAAmericas
9516hgftysUSAAmericasUSAAmericasUSAAmericas
4567gha
 

Mentor82

Active Member
Joined
Dec 30, 2018
Messages
307
Hi,
Thanks for reply. Try this. This one places data from range A:AM to column D in sheet 1

VBA Code:
Sub ABC()
Dim LastRow&
Dim newRow&
Dim strRange$
Dim arr
Dim arrTrans
Dim str$
LastRow= Sheets(3).Cells(Rows.Count, "d").End(xlUp).Row


For i = 7 To LastRow
    strRange =CStr ("J" & i & ":AM" & i)
    If WorksheetFunction.CountA(RANGE(strRange)) <> 0 Then
        newRow=Sheets(1).Cells(Cells.Rows.Count,"D").End(xlup).Row + 1
        str = "A" & i & ":AM" & i
        arr = Sheets(3).Range(str)
        arrTrans = WorksheetFunction.Transpose(arr)
        Sheets(1).Range("D" & newRow).Resize(UBound(arrTrans)) = arrTrans
    End If
Next
MsgBox "Done"

End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
38,993
Office Version
365
Platform
Windows
Have you tried the code in post#12?
 

Harshil Mehta

New Member
Joined
May 14, 2020
Messages
19
Office Version
2013
Platform
Windows
How about
VBA Code:
Sub HarshilMehta()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long, cc As Long
  
   With Sheets(3)
      Ary = .Range("A6:AM" & .Range("D" & Rows.Count).End(xlUp).Row).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To UBound(Ary, 2))
   For r = 1 To UBound(Ary)
      For c = 10 To UBound(Ary, 2)
         If Ary(r, c) <> "" Then
            nr = nr + 1
            For cc = 1 To UBound(Ary, 2)
               Nary(nr, cc) = Ary(r, cc)
            Next cc
            Exit For
         End If
      Next c
   Next r
   Sheets(1).Range("A1").Resize(nr, UBound(Ary, 2)).Value = Nary
End Sub
Sorry for late reply. This code worked well but what I am trying to do is copy the range if condition <>"" is met then copy range A:AM of sheet3 to sheet 1 till the last cell of column D in sheet3 and then reverse the condition to ="" and copy the copy range A:AM of sheet3 to sheet 1 till the last cell of column D in sheet3. I have pasted the code below for your reference.


Sub HarshilMehta()
Dim Ary As Variant, Nary As Variant
Dim r As Long, c As Long, nr As Long, cc As Long

With Sheets(3)
Ary = .Range("A7:AM" & .Range("D" & Rows.Count).End(xlUp).Row).Value2
End With
ReDim Nary(1 To UBound(Ary), 1 To UBound(Ary, 2))
For r = 1 To UBound(Ary)
For c = 10 To UBound(Ary, 2)
If Ary(r, c) <> "" Then
nr = nr + 1
For cc = 1 To UBound(Ary, 2)
Nary(nr, cc) = Ary(r, cc)
Next cc
Exit For
End If
Next c
Next r
Sheets(1).Range("A2").Resize(nr, UBound(Ary, 2)).Value = Nary


With Sheets(3)
Ary = .Range("A7:AM" & .Range("D" & Rows.Count).End(xlUp).Row).Value2
End With
ReDim Nary(1 To UBound(Ary), 1 To UBound(Ary, 2))
For r = 1 To UBound(Ary)
For c = 10 To UBound(Ary, 2)
If Ary(r, c) = "" Then
nr = nr + 1
For cc = 1 To UBound(Ary, 2)
Nary(nr, cc) = Ary(r, cc)
Next cc
Exit For
End If
Next c
Next r
Sheets(1).Range("A2").Resize(nr, UBound(Ary, 2)).Value = Nary

End Sub

The highlighted lines seems to b buggy.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
38,993
Office Version
365
Platform
Windows
How about
VBA Code:
Sub HarshilMehta()
   Dim Ary As Variant, Nary As Variant, Nary2 As Variant
   Dim r As Long, c As Long, nr As Long, cc As Long, nr2 As Long
   Dim Flg As Boolean
   
   With Sheets(3)
      Ary = .Range("A6:AM" & .Range("D" & Rows.Count).End(xlUp).Row).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To UBound(Ary, 2))
   ReDim Nary2(1 To UBound(Ary), 1 To UBound(Ary, 2))
   For r = 1 To UBound(Ary)
      Flg = True
      For c = 10 To UBound(Ary, 2)
         If Ary(r, c) <> "" Then
            Flg = False
            nr = nr + 1
            For cc = 1 To UBound(Ary, 2)
               Nary(nr, cc) = Ary(r, cc)
            Next cc
            Exit For
         End If
      Next c
      If Flg Then
         nr2 = nr2 + 1
         For cc = 1 To UBound(Ary, 2)
            Nary2(nr2, cc) = Ary(r, cc)
         Next cc
      End If
   Next r
   Sheets(1).Range("A1").Resize(nr, UBound(Ary, 2)).Value = Nary
   Sheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(nr2, UBound(Ary, 2)).Value = Nary2
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,096,186
Messages
5,448,855
Members
405,533
Latest member
Heretical1

This Week's Hot Topics

Top