copy rows between header and the last row - excel

Question

I found and modified a code that works pretty well but I am struggling with Set CopyRng = sh.Range("A11:AI15") . What I want to do is to create a dynamic range that will copy values from first table from each worksheet between header called Language and last row in table called Total. Some cells are merged in the table (default template) and there are empty columns in the table (so .CurrentRegion doesn't work).
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function
Sub CopyRangeFromMultiWorksheets()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set DestSh = ActiveWorkbook.Worksheets("test")
' Loop through all worksheets and copy the data to the
' summary worksheet.
For Each sh In ActiveWorkbook.Worksheets
If sh.Name Like "test*" Then
Last = LastRow(DestSh)
' Specify the range to place the data.
Set CopyRng = sh.Range("A11:AI15")
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial
Application.CutCopyMode = False
End With
DestSh.Cells(Last + 1, "A").Resize(CopyRng.Rows.Count).Value = sh.Range("F8")
DestSh.Cells(Last + 1, "AK").Resize(CopyRng.Rows.Count).Formula = "=AG10*3%"
DestSh.Cells(Last + 1, "AL").Resize(CopyRng.Rows.Count).Formula = "=AG10+AK10"
End If
Next
ExitTheSub:
Application.Goto DestSh.Cells(1)
DestSh.Columns.AutoFit
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Regards,

Answer 1

Here is a function that will return you the range. Parameters explained:
oW = The worksheet you want to get the range from
sStartColHeader = Holds the name of the header column you want to start the range from (i.e. in your example this would be "Language")
Function GetRange(ByVal oW As Worksheet, ByVal sStartColHeader As String) As Range
Dim oTotRng As Range: Set oTotRng = oW.Cells.Find("total", oW.Cells(1, 1), xlValues, xlPart, xlByRows, xlNext, False, , False)
Dim oLan As Range
Set oLan = oW.Cells.Find(sStartColHeader, oW.Cells(1, 1), xlValues, xlPart, xlByRows, xlNext, False, , False)
If oLan Is Nothing Then
Set GetRange = Nothing
Else
Set GetRange = Range(oLan.Offset(1, 0), oTotRng.Offset(0, 1))
End If
End Function
How to use this function:
In CopyRangeFromMultiWorksheets function, change Set CopyRng = sh.Range("A11:AI15") to Set CopyRng = GetRange(sh, "Language"). Then have an If condition to check if a range was returned. For example:
Set CopyRng = GetRange(sh, "Language")
If CopyRng Is Nothing Then
' your exception code here as range was not returned
Else
' rest of your code here as a range was returned
End If
NOTE: Presumption is that the actual total amount in the sheet is in the cell to the right of the cell that contains the text Total. So if "H10" has text Total, actual total is held in cell "I10"

Answer 2

I have found a solution that works great. See the code below:
Sub CopyRangeFromMultiWorksheets()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range
Dim findrow As Long, findrow2 As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set DestSh = ThisWorkbook.Worksheets("Summary")
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
Last = LastRow(DestSh)
'this method doesn't work with merged cells thhat is why I have to unmerge them first.
sh.Range("B10:B200").UnMerge
findrow = sh.Range("B:B").Find("Language Pair", sh.Range("B1")).Row
findrow2 = sh.Range("B:B").Find("Total", sh.Range("B" & findrow)).Row
Set CopyRng = sh.Range("A" & findrow + 1 & ":AJ" & findrow2 - 1)
CopyRng.Copy
With DestSh.Cells(Last + 1, "B")
.PasteSpecial
Application.CutCopyMode = False
End With
DestSh.Cells(Last + 1, "A").Resize(CopyRng.Rows.Count).Value = sh.Range("F8")
DestSh.Cells(Last + 1, "AK").Resize(CopyRng.Rows.Count).Formula = "=AG10*3%"
DestSh.Cells(Last + 1, "AL").Resize(CopyRng.Rows.Count).Formula = "=AG10+AK10"
End If
Next
ExitTheSub:
Application.Goto DestSh.Cells(1)
DestSh.Columns.AutoFit
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function