Copy row to new sheet if cell value is a number

Stan101

New Member
Joined
Sep 2, 2016
Messages
18
I am try to have a whole row copied to the next available row in different worksheet within the same workbook if a cell value is numeric.

Sheet "Master" contains thousands of rows of data. there are some blank rows in between these data.
Working sequentially by row through sheet "Master", If cell "AI" on a row has a numeric value (ie: whole number or decimal) then copy it to "Sheet3" in the next available line.

This is what I have so far:

VBA Code:
Sub CopyToOtherSheet()
    Dim r As Range
    Dim i As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet

    Set Source = ActiveWorkbook.Worksheets("Master")
    Set Target = ActiveWorkbook.Worksheets("Sheet3")

    j = 1
  
    For Each r In Source.Range("AI:AI1000")
        If IsNumeric(r) = True Then
           Source.Rows(r.Row).Copy Target.Rows(i)
           i = i + 1
        End If
    Next r
End Sub

I have a fixed source range because I can't recall how to count total rows and have just be trying to get the rest working before I attempt to tackle that.

My ultimate goal would be to not only get the above working but to add the following so I may use it potentially for future use:
- Instead of having a fixed "sheet 3" destination, create it based on a cell name or sheet name after a test to see if it already created.
- Have a variant that works with non numeric values.
- Have this run on close of the workbook that holds sheet"Master" if possible.

Can anyone see what I am doing wrong? Any assistance would be greatly appreciated.
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,383
Office Version
  1. 2016
Platform
  1. Windows
What is the problem?

I see that you put j=1 but in loop you have i=i+1. So, initial i=0 will give error
 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,383
Office Version
  1. 2016
Platform
  1. Windows
One way to find last occupied row (from bottom up):
LastRow = Source.Cells(Rows.Count, "A").End(xlUp).Row
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,339
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
How about
VBA Code:
Sub CopyToOtherSheet()
Dim r As Long, i As Long, Source As Worksheet, Target As Worksheet
Dim lr As Long, lr2 As Long
Set Source = Worksheets("Master")
Set Target = Worksheets("Sheet3")
lr = Source.Cells(Rows.Count, "AI").End(xlUp).Row
lr2 = Target.Cells(Rows.Count, "A").End(xlUp).Row + 1
    For r = 1 To lr
        If IsNumeric(Range("AI" & r).Value) = True Then
           Rows(r).Copy Target.Range("A" & lr2)
           lr2 = Target.Cells(Rows.Count, "A").End(xlUp).Row + 1
        End If
    Next r
End Sub
 

Stan101

New Member
Joined
Sep 2, 2016
Messages
18

ADVERTISEMENT

How about
VBA Code:
Sub CopyToOtherSheet()
Dim r As Long, i As Long, Source As Worksheet, Target As Worksheet
Dim lr As Long, lr2 As Long
Set Source = Worksheets("Master")
Set Target = Worksheets("Sheet3")
lr = Source.Cells(Rows.Count, "AI").End(xlUp).Row
lr2 = Target.Cells(Rows.Count, "A").End(xlUp).Row + 1
    For r = 1 To lr
        If IsNumeric(Range("AI" & r).Value) = True Then
           Rows(r).Copy Target.Range("A" & lr2)
           lr2 = Target.Cells(Rows.Count, "A").End(xlUp).Row + 1
        End If
    Next r
End Sub
Hi Michael,

I tried this code and it is running but it is running very slowly. It has been running for about 7 minutes so far. CPU load is light and ram use is light though. I see the word "Calculating" in the bottom left of the Excel screen so it is still running. In that time it copied 350 lines to sheet 3.

I stopped the code eventually with F5 and see that in Sheet3, every line from Sheet Master has started to be copied regardless of what is in cell AI.

What is the problem?

I see that you put j=1 but in loop you have i=i+1. So, initial i=0 will give error
I don't know what happened there.

But when all J I still get no result.
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,339
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
1. Is Master the active sheet when the process is run
2. Are the cells solely numeric or a mixture of text and numbers
3. how many rows are involved here ?
The code ran fine for me !!
AND
what is the relevence of J as it doesn't appear to have any impact on the code as first presented ?
 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,383
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

Try this

VBA Code:
Sub CopyToOtherSheet()
    Dim r As Range
    Dim i As Long, eRow As Long
    Dim Source As Worksheet
    Dim Target As Worksheet

    Set Source = ActiveWorkbook.Worksheets("Master")
    Set Target = ActiveWorkbook.Worksheets("Sheet3")
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    eRow = Source.Range("AI" & Source.Rows.Count).End(xlUp).Row
    i = 1
  
    For Each r In Source.Range("AI1", "AI" & eRow)
        If IsNumeric(r) = True Then
           Source.Rows(r.Row).Copy Target.Rows(i)
           i = i + 1
        End If
    Next r
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub
 

vcoolio

Well-known Member
Joined
Jun 29, 2014
Messages
1,113
Hello Stan,

If the values are actually numeric (refer to Michael's post #6) then this could work for you:-

VBA Code:
Sub CopyToOtherSheet()
    
    Dim Source As Worksheet
    Dim Target As Worksheet

    Set Source = Sheets("Master")
    Set Target = Sheets("Sheet3")
    
Application.ScreenUpdating = False

    Source.Range("AI2", Source.Range("AI" & Source.Rows.Count).End(xlUp)).SpecialCells(2, 1).EntireRow.Copy Target.Range("A" & Rows.Count).End(3)(2)
   
Application.ScreenUpdating = True

End Sub

I'm assuming that there are headings in row1 with data starting in row2.

I hope that this helps.

Cheerio,
vcoolio.
 

Stan101

New Member
Joined
Sep 2, 2016
Messages
18
Thank you for all your assistance everyone. I will look at all your code and use it to renew my learning.

I have actually got the result I need. I stopped and looked at what I really wanted to achieve and came up with what I think is an easier solution. And best of all, it works for me.

I actually think the hardest part of VBA for me is formatting and roughing out what I really need to achieve and the flow I should use to get there. I see lots of code training on line. I see very little code planning tutorials online. I also forget what commands are actually available to me.

Any way thanks again. This is how I achieved what I needed. It might assist someone else at some stage.

VBA Code:
Public Sub CopySheetToEndAnotherWorkbook()

Dim currentwb As Workbook
Set currentwb = ThisWorkbook

    Worksheets("Master").Copy After:=Worksheets("Cal")
      
For Each Sheet In ActiveWorkbook.Worksheets
    If Sheet.Name = "loor CSV" Then
        Application.DisplayAlerts = False
        Worksheets("loor CSV").Delete
        Application.DisplayAlerts = True
    End If
Next Sheet


    ActiveSheet.Name = "loor CSV"
    DeleteBlankRows
    currentwb.Save

Application.DisplayAlerts = False

 ActiveSheet.Copy

 ActiveWorkbook.SaveAs "D:\Excel Files\CSV TEST\loor.CSV", FileFormat:=6
    ActiveWorkbook.Close
    
Application.DisplayAlerts = True
    
currentwb.Worksheets("loor").Activate
End Sub

Sub DeleteBlankRows()
On Error Resume Next
    Columns("AI").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
 
Solution

Watch MrExcel Video

Forum statistics

Threads
1,132,703
Messages
5,654,823
Members
418,155
Latest member
demasisi

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top