Macro that to transfer information sheets by product

[k0st4din]

Hello everyone,
asking for your help to make a macro that I can not handle.
First published and made an inquiry on this site, but no response yet.
please you for your assistance to make a macro that automates the actions that I do manually.
Each month, receive information about products sold, which copy and put in a master file. I have over 80 separate sheets with the names of each product. Once the information transmitted for example January, I save the file and wait for the information to come next month. Then filter the new month and start again manually choose products (!!! very important - have the same products but with different weight in grams) and put the information in the last line of the previous month, ie should be cumulative. Attach sample file and give a link if you want to watch and video.
Thank you in advance for your cooperation on your part.
Link to file
Link to video

[mancubus]

k0st4din!

you are not a VBAX newbie and you know you can post your workbook here.

that said, i assume:
the leftmost worksheet contains consolidated data of products sold.
each month you want to split previous month's data. (so whey you run below code now, it will split 2014-November's sales data.)

Sub Split_Monthly_Sales_To_Product_Worksheets()


    Dim ProductNames As String
    Dim Products
    Dim i As Integer
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With


    For i = 2 To Worksheets.Count
        ProductNames = ProductNames & "|" & Worksheets(i).Name
    Next


    Products = Split(Mid(ProductNames, 2), "|")
    
    With Worksheets(1)
        .AutoFilterMode = False
        .Cells(1).AutoFilter Field:=1, Criteria1:=xlFilterLastMonth, Operator:=xlFilterDynamic
        For i = LBound(Products) To UBound(Products)
            .Cells(1).AutoFilter Field:=3, Criteria1:="=*" & Products(i) & "*"
            With .AutoFilter.Range
                If .Rows.Count > 1 Then
                    .Offset(1).Copy Worksheets(Products(i)).Range("A" & Rows.Count).End(xlUp).Offset(1)
                End If
            End With
        Next i
        .AutoFilterMode = False
    End With


End Sub

[mancubus]

        .Cells(1).AutoFilter Field:=1, Criteria1:=xlFilterLastMonth, Operator:=xlFilterDynamic

this is a special date filter for previous month.
if you want to filter data for a month of choice, you should modify this line.

[k0st4din]

Hello mancubus,
many thanks for the support of your country for this macro, but I have some questions:
1. How exactly chose to be this November, as the table I set the example in January and December. (but otherwise is very cleverly done from your side, thus no loads system)
2. This question is perhaps linked with the first - ie I made a button and there is macro(Module4), but pushed it nothing happens, ie there is no transfer of information (product sheets on them)?
3. This additional line that I (if I want and I can change) - less is not my clear - ie could you handing me some example of what will be changed in line to become the January month (for example)
Thank you infinitely many

[mancubus]

welcome.

1) you may ask for a date entry. in this case you have to change the first autofilter.
2) because Column A does not contain dates in November 2014.
3) like so:

Sub Split_Monthly_Sales_To_Product_Worksheets()


    Dim ProductNames As String
    Dim Products
    Dim i As Integer
    Dim LastDateInMonth As String


    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With


    For i = 2 To Worksheets.Count
        ProductNames = ProductNames & "|" & Worksheets(i).Name
    Next


    Products = Split(Mid(ProductNames, 2), "|")
    
    LastDateInMonth = Application.InputBox("Enter Last Date of Month in 'MM/DD/YYYY' format Like 11/30/2014")
    
    With Worksheets(1)
        .AutoFilterMode = False
        .Cells(1).AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(1, LastDateInMonth)
        For i = LBound(Products) To UBound(Products)
            .Cells(1).AutoFilter Field:=3, Criteria1:="=*" & Products(i) & "*"
            With .AutoFilter.Range
                If .Rows.Count > 1 Then
                    .Offset(1).Copy Worksheets(Products(i)).Range("A" & Rows.Count).End(xlUp).Offset(1)
                End If
            End With
        Next i
        .AutoFilterMode = False
    End With

End Sub

[k0st4din]

Hello mancubus,
and this macro is superb.
Thank you for your endless support.

Otherwise both macro is super, super, super...............

Thank you

[mancubus]

you are welcome.

pls mark the thread as "solved" from thread tools dropdown which is above the first message.

[k0st4din]

Hello mancubus,
both macros do a perfect job - for which I thank you very much.
I would like to ask you (in view of the fact that there have been some changes) if he could tell me how to do so sheet that collect sales each month - in the macro I give him a name?
Ie in your macro you tell me the following: If the database is the left sheet (first at left)
your words - "the leftmost worksheet contains consolidated data of products sold."
My idea is that nothing changes in the macro because it works flawlessly, but sometime in the early to add something, I ask him the name of the sheet from which to carry information on all other sheets. In this way I will be able to put in the same workbook same macro (but with a different name) and there only to change the name of the sheet and again I carry all the information sheets.
Is it possible to rework a little early this wonderful macro?
Thank you in advance and happy holidays.

Sub Split_Monthly_Sales_To_Product_Worksheets_name_of_sheet_Product() 'the first
'Is it possible to revise and add me to write from which sheet to carry information on all other sheets

    Dim ProductNames As String
    Dim Products
    Dim i As Integer
    Dim LastDateInMonth As String


    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With


    For i = 2 To Worksheets.Count
        ProductNames = ProductNames & "|" & Worksheets(i).Name
    Next


    Products = Split(Mid(ProductNames, 2), "|")
    
    LastDateInMonth = Application.InputBox("Enter Last Date of Month in 'MM/DD/YYYY' format Like 11/30/2014")
    
    With Worksheets(1)
        .AutoFilterMode = False
        .Cells(1).AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(1, LastDateInMonth)
        For i = LBound(Products) To UBound(Products)
            .Cells(1).AutoFilter Field:=3, Criteria1:="=*" & Products(i) & "*"
            With .AutoFilter.Range
                If .Rows.Count > 1 Then
                    .Offset(1).Copy Worksheets(Products(i)).Range("A" & Rows.Count).End(xlUp).Offset(1)
                End If
            End With
        Next i
        .AutoFilterMode = False
    End With

End Sub

and other macro that will be for another worksheet

Sub Split_Monthly_Sales_To_Product_Worksheets_name_of_sheet_Product_another_worksheet() 'the second
'Is it possible to revise and add me to write from which sheet to carry information on all other sheets

    Dim ProductNames As String
    Dim Products
    Dim i As Integer
    Dim LastDateInMonth As String


    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With


    For i = 2 To Worksheets.Count
        ProductNames = ProductNames & "|" & Worksheets(i).Name
    Next


    Products = Split(Mid(ProductNames, 2), "|")
    
    LastDateInMonth = Application.InputBox("Enter Last Date of Month in 'MM/DD/YYYY' format Like 11/30/2014")
    
    With Worksheets(1)
        .AutoFilterMode = False
        .Cells(1).AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(1, LastDateInMonth)
        For i = LBound(Products) To UBound(Products)
            .Cells(1).AutoFilter Field:=3, Criteria1:="=*" & Products(i) & "*"
            With .AutoFilter.Range
                If .Rows.Count > 1 Then
                    .Offset(1).Copy Worksheets(Products(i)).Range("A" & Rows.Count).End(xlUp).Offset(1)
                End If
            End With
        Next i
        .AutoFilterMode = False
    End With

End Sub

I just have to have two worksheets from which to carry on the same location information

[mancubus]

so you have 2 worksheets which contain sales data and you want to choose between them.

one way to do this is to make the user input the worksheet name.

chance SalesData1 and SalesData2 in below code to actual worksheet names in your worbook.

Sub Split_Monthly_Sales_2ws_To_Product_Worksheets()

    Dim ProductNames As String, wsSales As String, LastDateInMonth As String
    Dim Products
    Dim i As Integer

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    For i = 1 To Worksheets.Count
        If Worksheets(i).Name <> "SalesData1" And Worksheets(i).Name <> "SalesData2" Then
            ProductNames = ProductNames & "|" & Worksheets(i).Name
        End If
    Next

    Products = Split(Mid(ProductNames, 2), "|")
    wsSales = Application.InputBox(Prompt:="Input the name of the worksheet which contains the sales data!", Type:=2)
    LastDateInMonth = Application.InputBox(Prompt:="Enter Last Date of Month in 'MM/DD/YYYY' format Like 11/30/2014", Type:=2)
    
    With Worksheets(wsSales)
        .AutoFilterMode = False
        .Cells(1).AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(1, LastDateInMonth)
        For i = LBound(Products) To UBound(Products)
            .Cells(1).AutoFilter Field:=3, Criteria1:="=*" & Products(i) & "*"
            With .AutoFilter.Range
                If .Rows.Count > 1 Then
                    .Offset(1).Copy Worksheets(Products(i)).Range("A" & Rows.Count).End(xlUp).Offset(1)
                End If
            End With
        Next i
        .AutoFilterMode = False
    End With

End Sub

[k0st4din]

Hello mancubus,
Super macro is invented by you, carried by two worksheets information exactly where it should be.
Thank you from my heart for your help.

[mancubus]

you are welcome.
thanks but i did not invent it.
i just organized some coding to meet your requirements.

[k0st4din]

Hello mancubus,
it's been so many years and this macro that helped me and to this day it does a great job for me.
I just have no words to thank you for.
I have a request if the same macro can change slightly after the moment of copying the information.


In principle, the distribution is the same as the way the macro works, but whether it can be made through certain columns to skip 2 empty columns and retrieve the same information (as it is).
Immediately I give an example:
Using the macro, in the first window that pops up, I am asked from which worksheet to copy the information and spread it on the other worksheets. Immediately after the first window pops up, a second window appears to write for which date. And the copying begins.
Everything is super, super, super - wonderful.
I currently have information from A to F - and everything is copied exactly where it should be.
Now with this macro, though, I'm trying to help myself to another table, but a little different.
I have to transfer information from A to F again, but:
The information in columns A and B of the selected worksheet (GL) and the date selected respectively - is allocated to the others on the other worksheets again in columns A and B.
The information from C and D and E is in columns E, F and G respectively
And the information from F be in J
Other worksheets in columns C, D, H and I have other information.
You may be confused, for this reason I attach an example table and if you have any questions, please ask me.
Thank you very much.

[mancubus]

you should have opened a new thread, with a reference to this thread, instead.

btw, it seems columns have changed and you want a non-contiguous paste.

try below code:

Sub vbax_51313_2014_req2019_Split_Monthly_Sales_2ws_To_Product_Worksheets()


    Dim ProductNames As String, wsSales As String, LastDateInMonth As String
    Dim Products, slsArr
    Dim i As Long, LastRow As Long


    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With


    For i = 1 To Worksheets.Count
        If Worksheets(i).Name <> "SalesData1" And Worksheets(i).Name <> "SalesData2" Then
            ProductNames = ProductNames & "|" & Worksheets(i).Name
        End If
    Next

    Products = Split(Mid(ProductNames, 2), "|")
    wsSales = Application.InputBox(Prompt:="Input the name of the worksheet which contains the sales data!", Type:=2)
    LastDateInMonth = Application.InputBox(Prompt:="Enter Last Date of Month in 'MM/DD/YYYY' format Like 11/30/2014", Type:=2)
    
    With Worksheets(wsSales)
        .AutoFilterMode = False
        .Cells(1).AutoFilter Field:=6, Operator:=xlFilterValues, Criteria2:=Array(1, LastDateInMonth)
        For i = LBound(Products) To UBound(Products)
            .Cells(1).AutoFilter Field:=1, Criteria1:="=*" & Products(i) & "*"
            If .AutoFilter.Range.Rows.Count > 1 Then
                .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Copy .Cells(1, 100)
                slsArr = .Cells(1, 100).CurrentRegion.Value
                .Cells(1, 100).CurrentRegion.Clear
                LastRow = Worksheets(Products(i)).Range("A" & Rows.Count).End(xlUp).Offset(1).Row
                Worksheets(Products(i)).Cells(LastRow, 1).Resize(UBound(slsArr, 1), 1).Value = Application.Index(slsArr, , 1)
                Worksheets(Products(i)).Cells(LastRow, 2).Resize(UBound(slsArr, 1), 1).Value = Application.Index(slsArr, , 2)
                Worksheets(Products(i)).Cells(LastRow, 5).Resize(UBound(slsArr, 1), 1).Value = Application.Index(slsArr, , 3)
                Worksheets(Products(i)).Cells(LastRow, 6).Resize(UBound(slsArr, 1), 1).Value = Application.Index(slsArr, , 4)
                Worksheets(Products(i)).Cells(LastRow, 7).Resize(UBound(slsArr, 1), 1).Value = Application.Index(slsArr, , 5)
                Worksheets(Products(i)).Cells(LastRow, 10).Resize(UBound(slsArr, 1), 1).Value = Application.Index(slsArr, , 6)
            End If
        Next i
        .AutoFilterMode = False
    End With

End Sub