VBA Copy and Paste data to another sheet(with a date and day)?

Now, I have a major problem with copy and paste data. My data have some format that need to fulfill. With characters, date and day. The output should be like this.... SEE the attachment below: BUT I can't copy some of the data because some problem occur and not being copy and paste correctly. Previous code: INCOMPLETE

Code:

---

Sub copyPasteData()
    Dim LResult As String
    i = 3
    n = 2
    For Each Sh In Worksheets
        If Sh.Name = "Head Office" Then
            With Sh.[A3]
                For k = 2 To .CurrentRegion.Columns.Count
                    LResult = Left(Sh.Name, 4)
                    Sheets("Head Office").Cells(i, 1).Resize(24) = Sh.Name
                    Sheets("Head Office").Cells(i, 2).Resize(24) = LResult
                    'Sheets("Head Office").Cells(i, 3).Resize(24) = Sheets("Head Office").Cells(i, 4).Resize(24) = .Columns(k).Value
                    'Sheets("Head Office").Cells(i, 5).Resize(24) = Sheets("Head Office").Cells(i, 6).Resize(24)=Intersect(.CurrentRegion,=.CurrentRegion.Offset(3).Columns(1)).Value
                    Sheets("Head Office").Cells(i, 7).Resize(24) = .CurrentRegion.Offset(3).Columns(n).Value
                    i = i + 24
                    n = n + 1
                Next k
            End With
        End If
        n = 2
    Next Sh
End Sub

---

Please see the attachment below: -> Need to be the OUTPUT WORKBOOK:

attach please a sample excel file, not image

mcmunoz, please review your code. I formatted it for readability purposes.

McMunoz,

I can't tell what you are trying to do, but if it can help you, the comments in the code below, say what the code is really doing. Each comment applies to the code below it.

Code:

---

Sub copyPasteData()
    Dim LResult As String
    i = 3
    n = 2
    'Loop thru all sheets until find Sheet("Head Office")
    For Each Sh In Worksheets
        If Sh.Name = "Head Office" Then
            'With Sheets("Head Office").Range("A3")
            With Sh.[A3]
                'For K = 2 to Sheets("Head Office").Range("A3").CurrentRegion.Columns.Count
                For k = 2 To .CurrentRegion.Columns.Count
                    'LResult = "Head"
                    LResult = Left(Sh.Name, 4)
                    'Range("A3:A27") = "Head Office"
                    Sheets("Head Office").Cells(i, 1).Resize(24) = Sh.Name
                    'Range("B3:B27") = "Head"
                    Sheets("Head Office").Cells(i, 2).Resize(24) = LResult
                    'Range("G3:G27") = Range("C6")' I think that range
                    Sheets("Head Office").Cells(i, 7).Resize(24) = .CurrentRegion.Offset(3).Columns(n).Value
                    'Move to Row 27
                    i = i + 24
                    'Move from Column "C" to Column "D" in line .Cells(i, 7)
                    n = n + 1
                'Repeat for number of columns
                Next k
            'Done with Sheets("Head Office".Range("A3")
            End With
        'Done With Sheets("Head Office")
        End If
        n = 2
    'Loop thru rest of sheets, but do nothing, because there can only be one "Head Office"
    Next Sh
End Sub

---