# Copy entire row if CountA <>0 to another sheet

#### jolivanes

##### Well-known Member
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.

### 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
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
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
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:
 id name Range J:M 1234 abc USA Americas USA Americas USA Americas 4567 gha 7894 tyfta USA Americas USA Americas USA Americas 9516 hgftys USA Americas USA Americas USA Americas

After:
 id name Range J:M 1234 abc USA Americas USA Americas USA Americas 7894 tyfta USA Americas USA Americas USA Americas 9516 hgftys USA Americas USA Americas USA Americas 4567 gha

#### Harshil Mehta

##### New Member
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:
 id name Range J:M 1234 abc USA Americas USA Americas USA Americas 4567 gha 7894 tyfta USA Americas USA Americas USA Americas 9516 hgftys USA Americas USA Americas USA Americas

After:

 id name Range J:M 1234 abc USA Americas USA Americas USA Americas 7894 tyfta USA Americas USA Americas USA Americas 9516 hgftys USA Americas USA Americas USA Americas 4567 gha

#### Mentor82

##### Active Member
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
Have you tried the code in post#12?

#### Harshil Mehta

##### New Member
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.

#### Harshil Mehta

##### New Member
Hi,
Thanks for reply. Try this. This one places data from range A:AM to column D in sheet 1
I dont want my data to b transposed.

Last edited by a moderator:

#### Fluff

##### MrExcel MVP, Moderator
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``````