Test the next code, please:
Sub testCopySumQ()
Dim sh2 As Worksheet, shNS As Worksheet, c As Range
Dim lastR As Long, lastCol As Long, arrS, strForm As String
Set sh2 = ActiveSheet 'ActiveWorkbook.Worksheets("Sheet2")
Set shNS = sh2.Next 'Worksheets("NewSheet")
With sh2
Set c = .rows(6).Find("Q1 2020")
If Not c Is Nothing Then
lastR = .cells(rows.count, c.Column).End(xlUp).row 'last row on the c Column
lastCol = .cells(c.row, Columns.count).End(xlToLeft).Column 'last col (even with gaps)
strForm = "=SumIf(" & c.Offset(1, -5).Address & ":" & .cells(lastR, c.Column - 5).Address & _
", ""Gross Wage"", " & c.Offset(1).Address(0, 0) & ":" & .cells(lastR, c.Column).Address(0, 0) & ")"
.cells(lastR + 1, c.Column).Formula = strForm 'place the SumIf formula on last empty column cell
.cells(lastR + 1, c.Column).AutoFill Destination:=.Range(.cells(lastR + 1, c.Column), _
.cells(lastR + 1, lastCol)), Type:=xlFillDefault 'fill the formula to right
With .Range(.cells(lastR + 1, c.Column), .cells(lastR + 1, lastCol))
arrS = .Value 'put the value in an array
.ClearContents 'clear the helper row
End With
'drop the array value
shNS.cells(10, 11).Resize(UBound(arrS), UBound(arrS, 2)).Value = arrS
End If
End With
MsgBox "Ready..."
End Sub
But do you really need to always paste in "K10" cell? Or in the last empty cell of "K:K" column? Just in case of inserting other columns between this column and the one keeping the quarter string.
Edited:
I used for the column where "Gross Wage" string exists Offset(1, -5)
, meaning to be on the fifth column before the column where "Q1 2020" will be found...
与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…