Copy an entire row from one sheet to another based on a cell's value

[eccles291]

Hello,

Please help me from going totally insane! I'm not hugely experienced with Excel and have no idea about VLookups, Macros or VBA but I've been hunting for the answer to my problem for hours and hours with no success!!

I have a spreadsheet for our small building company where I want to keep track of all our purchases but also be able to detail what's been bought for each separate job that we're doing as we have a few sites on the go at once. I have one workbook with several sheets on it. Sheet 1 is "Total Purchases" which is where I'll enter the data and each separate job has it's own named sheet within the workbook. eg - sheet 2 is: "Anvil Cottage 001" , sheet 3 is "35 The Leys 002" , sheet 4 is "PFB 003" etc. The incremented numbers 001, 002, 003 are our job reference number which is used to identify them on the "Total Purchases" sheet in column E.

From trawling through this site, and many others, I've found and tried to adapt a Macro that will look down column E on the "Total Purchases" sheet and wherever it finds "001" it then copies that entire row to the "Anvil Cottage 001" sheet. When it finds "002" in column E it copies that entire row to "35 The Leys 002" sheet and so on. Hopefully this makes sense.

What doesn't seem to work is the Macro that I've tried to use. I've only done it for the "Anvil Cottage 001" sheet so far, and I'm sure I'll have to use a similar Macro on each sheet (with the corresponding details in the macro for each different job name) but this first one is not working. This is the Macro I've got:


Sub CopyRow()
Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Sheets("Total Purchases").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim x As Long
x = 3
Dim rng As Range
For Each rng In Sheets("Total Purchases").Range("E3:E" & LastRow)
If rng = "001" Then
rng.EntireRow.Copy
Sheets("Anvil Cottage 001").Cells(x, 1).PasteSpecial xlPasteValues
x = x + 1
End If
Next rng
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub




Where is it going wrong?! I'm using Excel for Mac 2016 (Version 16.16.3) if that makes much difference.

Thank you so much.

ray:

 

[Fluff]

Hi & welcome to MrExcel.
Check that the values in col E are text numbers like 001 rather than real numbers (ie 1) formatted to look like 001

 

[eccles291]

Hi & welcome to MrExcel.
Check that the values in col E are text numbers like 001 rather than real numbers (ie 1) formatted to look like 001

Thank you so much! That was what it was. I'm surprised (and relieved) that it was something as simple as that.

 

[Fluff]

Glad to help & thanks for the feedback.

 

[eccles291]

A slight odd thing that happened when I ran the Macro, although Sheet 2 "Anvil Cottage 001" copied all the correct data across, sheet 3 "35 The Leys 002" also copied over it's own correct data. However, nothing happened on sheet 4 "PFB 003". Any ideas what's happened there?

 

[Fluff]

Did you get any error messages?
If not I suspect it couldn't find any cells in col E with 3 or 003, depending on what your looking for.

 

[eccles291]

Did you get any error messages?
If not I suspect it couldn't find any cells in col E with 3 or 003, depending on what your looking for.

Nope, no error messages at all. Do I need to add a new Macro on each sheet for that particular sheet's reference i.e 002 and 003 etc?

 

[Fluff]

Are the values in col E like 1,2 etc or 001, 002 etc?

 

[eccles291]

I've entered them as 001, 002. From now onwards all our projects will be numbered incrementally so I thought it best to start it all off with leading zeros.

 

[Fluff]

Ok, if you setup a list of job numbers/sheet names like

Excel 2013/2016
	A	B
1	Job No	Sheet
2	001	Anvil Cottage 001
3	002	35 The Leys 002
4	003	PFB 003
List

You could then try

Sub CopyRow()
   Application.ScreenUpdating = False
   Dim LastRow As Long
   Dim fnd As Range, rng As Range, Lst As Range
   
   Set Lst = Sheets("List").Range("A1").CurrentRegion
   LastRow = Sheets("Total Purchases").Cells.find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

   For Each rng In Sheets("Total Purchases").Range("E3:E" & LastRow)
      Set fnd = Lst.find(rng.Value, , , xlWhole, , , False, , False)
      If Not fnd Is Nothing Then
         rng.EntireRow.Copy
         Sheets(fnd.Offset(, 1).Value).Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      End If
   Next rng
   Application.CutCopyMode = False
   Application.ScreenUpdating = True
End Sub

Using Autofilters would be quicker, but I have seen that sometimes causes problems on a Mac. And as I'm on a PC I have no way of testing.