copying cells from sheet 1 to various other sheets

[sbrown64]

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]

 

[Fluff]

Thanks for the file, could you also please answer the second part part of my question in post#36

 

[sbrown64]

ideally it would be better if the user did not have to delete all to refresh it

 

[Fluff]

The user doesn't need to delete the data on the company sheets, the macro can do that.
It's more a matter of whether the users are changing or adding anything to company sheets.

 

[sbrown64]

the user will add more lines as the info comes in, so that could be an existing company or maybe even a new one, but at the end of each month the bosses would like the inputter be able to print out individual company data and maybe even the full master sheet at times. There may be times that info needs to be corrected if entered incorrectly.

Regards

Stephen

 

[Fluff]

Ok, try this

Sub sbrown64()
   Dim Cl As Range
   Dim Ky As Variant
   Dim Ws As Worksheet
   Dim UsdRws As Long
   
   Set Ws = Sheets(1)
   UsdRws = Ws.Range("D" & Rows.Count).End(xlUp).Row
   With CreateObject("Scripting.dictionary")
      .CompareMode = vbTextCompare
      For Each Cl In Ws.Range("D5:D" & UsdRws)
         If Cl.Value <> "" Then .item(Trim(Cl.Value)) = Empty
      Next Cl
      For Each Ky In .Keys
         Ws.Range("A4:M" & UsdRws).AutoFilter 4, Ky
         Ws.Range("A4:M" & UsdRws).AutoFilter 13, ""
         If Not Evaluate("isref('" & Left(Ky, 30) & "'!A1)") Then
            Sheets.Add(, Sheets(1)).Name = Left(Ky, 30)
            Ws.Range("A1:A" & UsdRws).SpecialCells(xlVisible).EntireRow.Copy Sheets(Left(Ky, 30)).Range("A1")
            Ws.Range("M5:M" & UsdRws).SpecialCells(xlVisible).Value = Date
         Else
            On Error Resume Next
            Ws.Range("A5:A" & UsdRws).SpecialCells(xlVisible).EntireRow.Copy Sheets(Left(Ky, 30)).Range("D" & Rows.Count).End(xlUp).Offset(1, -3)
            Ws.Range("M5:M" & UsdRws).SpecialCells(xlVisible).Value = Date
            On Error GoTo 0
         End If
      Next Ky
   End With
   Ws.AutoFilterMode = False
End Sub

It will add a date in col M to show that data has been copied & won't be copies again.
I also notice that one of the company names is longer than the max allowed length for a sheet name, so I have capped it 30 characters.

 

[sbrown64]

Hi

Thank you for that, i will give it a go and let you know. Thank you for all your help, I will report back as soon as i can, but the wife is now shouting at me to put the BBQ on!

Regards
Stephen

 

[sbrown64]

Hi Fluff

Thank you very much for your efforts.

i have entered the code and clicked run and it worked. My question is if an inputter enters a new line of data of the master sheet, how do they update the sheets accordingly? the inputter in question knows next to nothing about computers? just as a thought, how do we check all data has been copied across when there are so many lines? is it a case of an error message would have popped up?

Regards

Stephen

 

[Fluff]

If you select A5, then on the view tab select Freeze panes, then select freeze panes again from the drop down menu. That will keep the top 4 rows visible at all times & you could put a button, or shape in that area & assign the macro to it, then all the user has to do is click the button/shape.

 

[sbrown64]

Sorry for sounding a bit thick! how do i create a macro?

 

[Fluff]

You don't need to create a macro, that's what the code in post#45 is.
To create a shape & assign the macro to it, have a look here https://www.excelcampus.com/vba/macro-buttons/
and scroll down to "1. Using Shapes to Create Macro Buttons"