Move data to another sheet with few conditions

[Marc L]

So to keep the cells formatting the Excel basics Copy well does the job with your initial post attachment.​

The dictionary is usefull to fast count the matching rows by category so without​

I can count the rows # to transfer without any category detail like a message « Rows to transfer : 99 of 348 » …​

For the category detail without a fast easy dictionary, maybe combining an advanced filter with some COUNTIF formulas..​

Could be understandable only for people knowing Excel basics and, reading Excel help like VBA help as well …​

​

So the question is : do you really need this message box, with or without a category detail ?​

​

 

[Anbuselvam K]

Boss,
The MsgBox is just to cross-check how many rows we entered data and how many of them going to transfer to the destination.
So if the transfer works only for the selected cell rows, then no need MsgBox as I know what I selected.
Also, only the first time I transfer huge rows of data, then two days once or weekly once only I will be initiating the transfer so the number of rows will be very less. MsgBox Not much important

 

[Marc L]

According to your initial post attachment - as it is - a starter Excel basics only VBA demonstration​

to paste only to its Sheet1 (Production) worksheet module :​

Sub Demo1()
        Dim C%, Rc(1) As Range, L&, S, V, R&, M$
    With [A4].CurrentRegion.Rows
        If .Count < 3 Then Beep: Exit Sub
        C = .Columns.Count + 1
        Set Rc(0) = .Item("2:" & .Count).Resize(, C).Columns
        Set Rc(1) = .Item("3:" & .Count).Columns
    End With
        Application.ScreenUpdating = False
        With Rc(1)(C):  .Formula = "=(COUNTA(A6:Q6)=17)+0":  .Formula = .Value:  L = Application.Sum(.Value):  End With
    If L Then
            S = "SUMPRODUCT((" & Rc(1)(10).Address & "=""#"")*" & Rc(1)(C).Address & ")"
            [XFC1] = [J5]
            [XFD1:XFD2] = [{"COMP";1}]
            Rc(0).Cells(C) = [XFD1]
            Rc(0).AdvancedFilter 2, [XFD1:XFD2], [XFC1], True
            V = [XFC1].CurrentRegion.Columns(1)
            For R = 2 To UBound(V):  M = M & vbLf & Evaluate(Replace(S, "#", V(R, 1))) & vbTab & V(R, 1):  Next
            If L < Rc(1).Rows.Count Then M = M & vbLf & vbLf & Rc(1).Rows.Count - L & vbTab & "Incomplete"
        If MsgBox(" #" & vbTab & "Category" & vbLf & M, 36, "Proceed") = 6 Then
            If ActiveWindow.FreezePanes Then S = Array(ActiveWindow.SplitColumn, ActiveWindow.SplitRow)
        For R = 2 To UBound(V)
            If Evaluate("ISREF('" & V(R, 1) & "'!A1)") = False Then
                Sheets.Add(, Sheets(Sheets.Count)).Name = V(R, 1)
                Rc(1).Rows(0).Copy
                With ActiveSheet:  .[A1].PasteSpecial 8:  .Paste .[A5]:  .[A5].RowHeight = [A5].RowHeight:  End With
                If IsArray(S) Then ActiveWindow.SplitColumn = S(0): ActiveWindow.SplitRow = S(1): ActiveWindow.FreezePanes = True
            End If
                [XFC2] = V(R, 1)
                Rc(0).AdvancedFilter 1, [XFC1:XFD2]
                Rc(1).Copy Sheets(V(R, 1)).Cells(Rows.Count, 1).End(xlUp)(2)
                Rc(1).Clear
        Next
            ShowAllData
            Rc(0).Sort [B5], 1, Header:=1
        End If
            [XFC1].CurrentRegion.Clear
    Else
        MsgBox "All are incomplete", 48, "Data rows"
    End If
        Rc(0)(C).Clear
        Application.ScreenUpdating = True
        Erase Rc
End Sub

Do you like it ? So thanks to click on bottom right Like !​

​

 

[Anbuselvam K]

It is working great Boss, Thanks a lot for your support.

 

[Marc L]

In fact a bit more complex without a dictionary, like a version for Mac when not using a Collection as a Dictionary !​

​