Hi kopico
Welcome to the Forum!
If I understand your issue, this Code appears to do as you require. You'll need to play with the Formating of the output. I've demonstrated how to do that in the second to last line of the Code
Option Explicit
Sub Merge_Sheets()
Dim sLR As Long, sLC As Long, tNR As Long, tCol As Long
Dim sWs As Worksheet, tWs As Worksheet
Dim sRng As Range
Dim sCel As Range
Set tWs = Sheets("Summary")
For Each sWs In ThisWorkbook.Sheets
If Not sWs.Name = "Summary" Then
Application.ScreenUpdating = False
tNR = tWs.Cells.Find("*", tWs.Cells(Rows.Count, Columns.Count), SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row + 1
With sWs
sLR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
sLC = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
Set sRng = .Range(.Cells(1, 1), .Cells(1, sLC))
For Each sCel In sRng
.Range(.Cells(2, sCel.Column), .Cells(sLR, sCel.Column)).Copy
On Error Resume Next
tCol = WorksheetFunction.Match(sCel, tWs.Rows("1:1"), 0)
tWs.Cells(tNR, tCol).PasteSpecial (xlPasteValues)
On Error GoTo 0
Next sCel
End With
End If
Application.CutCopyMode = False
Next sWs
tWs.Columns(1).NumberFormat = "m/d/yyyy"
Application.ScreenUpdating = True
End Sub
Bookmarks