copying cells from sheet 1 to various other sheets

sbrown64

Board Regular
Joined
Aug 23, 2019
Messages
87
Hi

I have a spreadsheet which has over 1000 lines, all for varying companies. What I would like to do is create an option so when you run it, it will copy the relevant lines to their respective sheet. The code listed below is some I have seen on here, which works to a point. It will run for one company, bit if I press run again it adds the same ones' to sheet 2. The other point is how to make it do if for ALL companies and not just the one? I hope you can help.

Regards

Stephen

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Sub Copy_Bd()
Application.ScreenUpdating = False
Dim i As Integer
Dim Lastrow As Long
Dim Lastrowa As Long[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Sheets(1).Activate
Lastrow = Cells(Rows.Count, "F").End(xlUp).Row
Lastrowa = Sheets(2).Cells(Rows.Count, "F").End(xlUp).Row + 1[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] For i = 1 To Lastrow
If Cells(i, 4).Value = "Bd" Then
Rows(i).Copy Destination:=Sheets(2).Rows(Lastrowa)
Lastrowa = Lastrowa + 1
End If
Next
Cells(1, 1).Select
Application.ScreenUpdating = True
End Sub[/FONT]
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
run time error 1004
application-defined or object defined error

also the sheet was empty, no data was copied across
 
Upvote 0
That suggests that is no data in Col D on "Sheet1"
Did you make sure that the sheet name I highlighted in red is looking at the correct sheet?
 
Upvote 0
Sheet 1 is the name and column D has all the company names

Bd
Bd
Cannon
LY
Cannon
Bd
Cannon
TSP
NHDC
Bd
Bd
NHDC
NHDC
Bd
Bd
Bd
Bd
Bd
LY
Bd
Cannon
Bd
Bd
Cannon
Bd

<colgroup><col></colgroup><tbody>
</tbody>
 
Upvote 0
Does the tab show "Sheet1" or "Sheet 1"?
 
Upvote 0
Do you have blank cells in col D?
If so try
Code:
Sub sbrown64()
   Dim Cl As Range
   Dim Ky As Variant
   Dim Ws As Worksheet
   
   Set Ws = Sheets("sheet1")
   With CreateObject("Scripting.dictionary")
      .CompareMode = vbTextCompare
      For Each Cl In Ws.Range("D2", Ws.Range("D" & Rows.Count).End(xlUp))
         If Cl.Value <> "" Then .item(Cl.Value) = Empty
      Next Cl
      For Each Ky In .Keys
         Sheets.Add(, Sheets(1)).Name = Ky
         Ws.Range("A1:D1").AutoFilter 4, Ky
         Ws.AutoFilter.Range.EntireRow.Copy Sheets(Ky).Range("A1")
      Next Ky
   End With
   Ws.AutoFilterMode = False
End Sub
 
Upvote 0
run time error 1004

cannot rename a sheet to the same name as another sheet, a referenced object library or a workbook referenced in VB.
 
Upvote 0
You said the other sheets didn't exist.
What do you want to happen if the other sheets already exist?
 
Upvote 0
Hi

I have just deleted all the pages except the main page and re-run the code and it has created a page for all companies, however without any headers, it has created a separate page called Company with headers. If i then run the code a second time it comes up with the error message and creates a blank page.

How do i run it more than once to update the pages as more data is entered?

update
just realised one of the companies has had two pages created with the same data?
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,510
Messages
6,114,048
Members
448,543
Latest member
MartinLarkin

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
Back
Top