repeat date and name in columns for invoice information based on sheet name

[Mussa-A]

Hi guys
I want copy invoice details from SL sheet to specific sheet based on cell D3 contains sheet name .
should repeat date and name and invoice no for B3,B5,B7 from SL to SH sheet in columns DATE, NAME, INVOICE NO up to TOTAL row as in my example based on sheet name in D3 also copy ITEM, ID,QTY ,UNIT PRICE ,TOTAL columns to ITEM, ID,QTY ,UNIT PRICE ,TOTAL columns in SH sheet after that should insert TOTAL row to sum column G as I did in requirement sheet . after copy from SL sheet I want clear cells B5,B7,A10:D with ignore any cell contains formula from clearing . as to TOTAL row in SL sheet is dynamic will add new rows before TOTAL row when I need more ID .
every time I will add new data(new details invoices in SL sheet) for so could reach the data for each sheet for about 4000 rows and should copy new details invoices to the bottom in each sheet.

[jindon]

Sub test()
    Dim a, i As Long
    With Sheets("sl")
        If Not .Evaluate("isref('" & .[d3] & "'!a1)") Then MsgBox "No sheet named; " & .[d3]: Exit Sub
        a = .[a9].CurrentRegion.Value
        a = Application.Index(a, Evaluate("row(2:" & UBound(a, 1) & ")"), [{1,1,1,1,2,3,4,5}])
        For i = 1 To UBound(a, 1)
            a(i, 1) = i: a(i, 2) = .[b3]: a(i, 3) = .[b5]: a(i, 4) = .[b7]
            If i = UBound(a, 1) Then a(i, 1) = "TOTAL"
        Next
        With Sheets(.[d3].Value).[a1].CurrentRegion
            .Offset(1).Interior.ColorIndex = xlNone
            .Offset(1).ClearContents
            With .Rows(2).Resize(UBound(a, 1))
                .Value = a
                .Cells(.Rows.Count, 1).Interior.Color = vbYellow
            End With
        End With
    End With
End Sub

[Mussa-A]

thanks ,but I want copy to the bottom ,not replace old data with new data and I want clearing filled data in SL sheet after copy to specific sheet as I said

I want clear cells B5,B7,A10:D with ignore any cell contains formula from clearing . as to TOTAL row in SL sheet is dynamic will add new rows before TOTAL row when I need more ID .

[jindon]

Sub test()
    Dim a, i As Long
    With Sheets("sl")
        If Not .Evaluate("isref('" & .[d3] & "'!a1)") Then MsgBox "No sheet named; " & .[d3]: Exit Sub
        a = .[a9].CurrentRegion.Value
        a = Application.Index(a, Evaluate("row(2:" & UBound(a, 1) & ")"), [{1,1,1,1,2,3,4,5}])
        For i = 1 To UBound(a, 1)
            a(i, 1) = i: a(i, 2) = .[b3]: a(i, 3) = .[b5]: a(i, 4) = .[b7]
            If i = UBound(a, 1) Then a(i, 1) = "TOTAL"
        Next
        With Sheets(.[d3].Value).Range("a" & Rows.Count).End(xlUp)(2)
            .Resize(UBound(a, 1)).Columns(1).Font.Bold = True
            .Resize(UBound(a, 1), UBound(a, 2)).Value = a
            .Cells(UBound(a, 1), 1).Interior.Color = vbYellow
        End With
        On Error Resume Next
        .[a9].CurrentRegion.Offset(1).SpecialCells(2) = ""
        On Error GoTo 0
        .[b3,b5,b7] = ""
    End With
End Sub

[Mussa-A]

thanks again
can avoid clear TOTAL word in last row for column A ? and I don't want repeating DAtE,NAME ,INVOICE NO in lastrow (TOTAL) ,sorry about my mistake in OP!

[jindon]

Change

        On Error Resume Next
        .[a9].CurrentRegion.Offset(1).SpecialCells(2) = ""
        On Error GoTo 0
        .[b3,b5,b7] = ""

to

        On Error Resume Next
        With .[a9].CurrentRegion
            .Offset(1).Resize(.Rows.Count - 2).SpecialCells(2) = ""
        End With
        On Error GoTo 0

If this is not what you want, upload a workbook showing After SL sheet.

[Mussa-A]

OK just see the TOTAL in lastrow for sh sheet doesn't repeat filling DATE,NAME,INVOICE NO , this is what I want it .
another thing after clear data and if I run the macro there is no data in SL sheet will continue copying to the bottom without data except ITEM and TOTAL row I don't need that as in WS sheet ,I don't want it . I want running the macro based on D3 is sheet name so I adjusted this line

        .[d3,b5,b7] = ""

if the D3 is empty then will not copy anything (because there is no sheet name to matching) and if I write wrong sheet name in D3 then will pops message "error sheet name".

[jindon]

Just add one line before On Error Resume Next

        .[b5,b7,d3] = ""   '<--- this line
        On Error Resume Next

[Mussa-A]

I'm not sure if you read well my last post !
it doesn't solve anything what I ask for it.

[jindon]

    With Sheets("sl")
        If [d3] = "" Then Exit Sub
        If Not .Evaluate("isref('" & .[d3] & "'!a1)") Then MsgBox "No sheet named; " & .[d3]: Exit Sub
        a = .[a9].CurrentRegion.Value
        If (a(2, 1) = "") + (a(2, 1) = "TOTAL") Then Exit Sub

[Mussa-A]

thanks again
but still filling DATE , NAME , INVOICE NO for adjacent cells for TOTAL row . I don't want it as I posted in SH sheet.

[jindon]

What you are presenting are confusing.

I always looked at "requirement" sheet for the result, so I wrote like that.

Sub test()
    Dim a, i As Long
    With Sheets("sl")
        If .[d3] = "" Then Exit Sub
        If Not .Evaluate("isref('" & .[d3] & "'!a1)") Then MsgBox "No sheet named; " & .[d3]: Exit Sub
        a = .[a9].CurrentRegion.Value
        If (a(2, 1) = "") + (a(2, 1) = "TOTAL") Then Exit Sub
        a = Application.Index(a, Evaluate("row(2:" & UBound(a, 1) & ")"), [{1,1,1,1,2,3,4,5}])
        For i = 1 To UBound(a, 1)
            If i < UBound(a, 1) Then
                a(i, 1) = i: a(i, 2) = .[b3]: a(i, 3) = .[b5]: a(i, 4) = .[b7]
            Else
                a(i, 1) = "TOTAL": a(i, 2) = "": a(i, 3) = "": a(i, 4) = ""
            End If
        Next
        With Sheets(.[d3].Value).Range("a" & Rows.Count).End(xlUp)(2)
            .Resize(UBound(a, 1)).Columns(1).Font.Bold = True
            .Resize(UBound(a, 1), UBound(a, 2)).Value = a
            .Cells(UBound(a, 1), 1).Interior.Color = vbYellow
        End With
        On Error Resume Next
        With .[a9].CurrentRegion
            .Offset(1).Resize(.Rows.Count - 2).SpecialCells(2) = ""
        End With
        On Error GoTo 0
        .[D3,b5,b7] = ""
    End With
End Sub

[Mussa-A]

What you are presenting are confusing.

my apologies !
now every thing is ok .
thank you so much for your time & help .