VBA to copy over Nil Values to different Tab

[kenadams378]

Hi,

I have the attached data which i need to pull account data across all the tabs that have zero values and transfer all the data to the 'Nil Accounts' tab?

Anyone have any ideas?

[JOHN H. DAVIS]

Maybe:

Sub kenaadams378()
Dim rcell As Range
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "Nil Accounts" Then
    ws.Activate
        For Each rcell In ws.Range("E1:E" & ws.UsedRange.Rows.count + 1)
            If rcell.Value = 0 Then
            rcell.EntireRow.Copy Sheets("Nil Accounts").Range("A" & Rows.count).End(3)(2)
            End If
        Next rcell
End If
Next ws
End Sub

[AB33]

Another option.

[kenadams378]

Many thanks, would it be possible to add which tab the data came from in column A, i also realised the data on the UL tab was not in the correct fields.

Please see amended file.

[JOHN H. DAVIS]

Maybe:

Sub kenaadams378()
Dim rcell As Range
Dim ws As Worksheet
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "Nil Accounts" And ws.Name <> "UL Data" Then
    ws.Activate
        For Each rcell In ws.Range("E1:E" & ws.UsedRange.Rows.count)
            If rcell.Value = 0 Then
            Sheets("Nil Accounts").Range("A" & Rows.count).End(3)(1) = ws.Name
            Sheets("Nil Accounts").Range("A" & Rows.count).End(3)(2) = ws.Name
            Range(rcell.Offset(, -4), rcell).Copy Sheets("Nil Accounts").Range("B" & Rows.count).End(3)(2)
            End If
        Next rcell
End If
Next ws
Sheets("UL Data").Activate
        For Each rcell In Range("K1:K" & ActiveSheet.UsedRange.Rows.count)
            If rcell.Value = 0 Then
            Sheets("Nil Accounts").Range("A" & Rows.count).End(3)(1) = ActiveSheet.Name
            Sheets("Nil Accounts").Range("A" & Rows.count).End(3)(2) = ActiveSheet.Name
            Range(rcell.Offset(, -4), rcell).Copy Sheets("Nil Accounts").Range("B" & Rows.count).End(3)(2)
            End If
        Next rcell
Sheets("Nil Accounts").Range("B1:F1").Delete
Sheets("Nil Accounts").Range("A" & Rows.count).End(3)(1).Delete
Application.ScreenUpdating = True
End Sub

[AB33]

Ken,

The code works as long as the sheets format remain unchanged, otherwise you may get out of range error.

[kenadams378]

Thanks again, i've had to change the structure of the model due to something been left out so all the data is now is a 'full list' tab, i then need to take out the nil values from this list and add them to the nil values tab.

This is my code

With Sheets("Full List")
        For Each rcell In ws.Range("C2:C" & ws.UsedRange.Rows.Count + 1)
            If rcell.Value = 0 Then
            rcell.EntireRow.Copy Sheets("Nil Accounts").Range("A" & Rows.Count).End(3)(2)
            End If
        Next rcell
End With

But it doesn't copy anything over

[JOHN H. DAVIS]

Your sample doesn't have a Sheets("Full List") and you have to change ws.usedrange to activesheet.usedrange

Sub kenaadams378()
Dim rcell As Range
Application.ScreenUpdating = False
Sheets("Nil Accounts").Rows("1:1").Value = Sheets("Full Data").Rows("1:1").Value
With Sheets("Full Data")
        For Each rcell In Range("C2:C" & ActiveSheet.UsedRange.Rows.count + 1)
            If rcell.Value = 0 Then
            rcell.EntireRow.Copy Sheets("Nil Accounts").Range("A" & Rows.count).End(3)(2)
            End If
        Next rcell
End With
Application.ScreenUpdating = True
End Sub

[kenadams378]

Thanks for this, it appears it only copies the top line and nothing else...

Ignore this post - Issue sorted

[kenadams378]

Apologies, using the same data above i've amended my code to the following;

With Sheets("Full Data")
lrow = .Range("A" & .Rows.Count).End(xlUp).Row
     For Each cel In .Range(.Cells(2, 3), .Cells(.Range("A1").End(xlDown).Row, 3))
         If cel.Value = 0 Then
         cel.EntireRow.Copy
         Worksheets("Nil Accounts").Range("A" & lrow).PasteSpecial xlValues
         End If
     Next cel
End With

But it just doesn't copy anything

[JOHN H. DAVIS]

Post #8 worked when I retested it?

[kenadams378]

Thanks, i have since taken the code in post 8 into a larger model (too much data to post here) and it only copies the top line?

[kenadams378]

Thanks for your help i have now solved the issue

Many thanks