Merge Cell range in first empty row

[js_odom]

I'm currently using this code to populate Cell B of the first empty row of Sheet1.

Public Sub PO_Notes()
Static oldval
If Range("J1").Value <> oldval Then
    oldval = Range("J1").Value
   
a = Worksheets("Temp").Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To a

If Worksheets("Temp").Cells(i, 2) = Worksheets("Sheet1").Cells(1, 10) Then


    
        Sheets("Temp").Select
        Range("F1").Select
        Selection.Copy
        Worksheets("Sheet1").Activate
        b = Worksheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Row
        Worksheets("Sheet1").Cells(b + 1, 2).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        With Selection.Font
        .Name = "Calibri"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
        Worksheets("Temp").Activate
       
        
        
End If
    
 Next
Application.CutCopyMode = False
Worksheets("Sheet1").Activate
ThisWorkbook.Worksheets("Sheet1").Cells(2, 1).Select
       
End If
End Sub

I would like to merge Cells B-F before or after populating Cell B so data fits in merged cells.
any suggestions?

 

[js_odom]

Ok, I found a solution, or at least a work around.
I added this to a new module

Public Sub PO_Notes_Merge()
Static oldval
If Range("J1").Value <> oldval Then
    oldval = Range("J1").Value
   
a = Worksheets("Temp").Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To a

If Worksheets("Temp").Cells(i, 2) = Worksheets("Sheet1").Cells(1, 10) Then


    
       
        Worksheets("Sheet1").Activate
        b = Worksheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Row
        Worksheets("Sheet1").Range(Cells(b, 2), Cells(b, 3)).Merge
        Worksheets("Sheet1").Range(Cells(b, 5), Cells(b, 6)).Merge
        Worksheets("Sheet1").Range(Cells(b, 2), Cells(b, 4)).Merge
        Worksheets("Sheet1").Range(Cells(b, 2), Cells(b, 5)).Merge
        Worksheets("Sheet1").Cells(b, 2).WrapText = True
        Worksheets("Sheet1").Cells(b, 2).VerticalAlignment = xlTop
        
End If
    
 Next
Application.CutCopyMode = False
Worksheets("Sheet1").Activate
ThisWorkbook.Worksheets("Sheet1").Cells(b, 2).Select
       
End If
End Sub

and this to another module

Public Sub AutoFitMergedCellRowHeight()
'----------------------------------------------
'\\ Jim RECH http://tinyurl.com/esbrx
'\\ This macro does an autofit of row heights on merged cells:

'\\ Simulates row height autofit for a merged cell if the active cell..
'\\ - is merged.
'\\ - has Wrap Text set.
'\\ - includes only 1 row.
'\\ Unlike real autosizing the macro only increases row height
'\\ (if needed). It does not reduce row height because another
'\\ merged cell on the same row may needed a greater height
'\\ than the active cell.
'----------------------------------------------

Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single

If ActiveCell.MergeCells Then
With ActiveCell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = ActiveCell.ColumnWidth
For Each CurrCell In Selection
MergedCellRgWidth = CurrCell.ColumnWidth + _
MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
End Sub

and all seems to work. Probably not the most efficient way but it does what I need.

thanks to all those that looked at this post.