Splitting data blocks based on title and copying into sheets named after them - excel

Question

I have a report I receive once a week with multiple data blocks that have dynamic rows and columns and each data block has a static title that will never change that are separated by a blank row. I am trying to copy these blocks into sheets based off of these titles.
I have a script that is creating the sheets and blank rows between data blocks with Python. But I am hoping to do the rest with VBA. Here is the end result Example.
Currently each of those sheets are blank, and I want to either copy paste or cut and paste the blocks into those sheets without their titles. i.e. A41:C46 into the Unanswered Service Level sheet.
Sub FormatExcel()
Dim LR As Long, i As Long
With Sheets("Master")
LR = .Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
With .Range("A" & i)
If .Value = "All Call Distribution by Queue" Then
ActiveCell.CurrentRegion.Select
Selection.Copy
Sheets("All Calls by Queue").Select
ActiveSheet.Paste
End If
End With
Next
End With
End Sub
This is what I have so far.
It will copy/paste into the designated sheet. But I'm stuck on why it's adding a second blank row at the top and how to code it so that if the sheet doesn't exist then nothing will happen. I am very new to VBA but I pieced this together from other code and just recording macros. Otherwise I was just going to copy and paste this code 15 times just with different sheet titles and .Values

Answer 1

You can use an approach like this:
Sub FormatExcel()
Dim ws As Worksheet, wb As Workbook
Set wb = ThisWorkbook 'ActiveWorkbook?
Set ws = wb.Worksheets("Master")
CopyBlock ws, "All Call Distribution by Queue", "All Calls by Queue"
CopyBlock ws, "Title2", "Title2 sheet"
'etc etc
End Sub
Sub CopyBlock(ws As Worksheet, title As String, destWS As String)
Dim f As Range, rng As Range, wsDest As Worksheet
'check if destination worksheet is present
On Error Resume Next 'ignore any error
Set wsDest = ws.Parent.Worksheets(destWS) 'check in same workbook as `ws`
On Error GoTo 0 'stop ignoring errors
If wsDest Is Nothing Then
Debug.Print "Missing sheet '" & destWS; "' in workbook '" & ws.Parent.Name & "'"
Exit Sub
End If
Set f = ws.Columns("A").Find(what:=title, lookat:=xlWhole) 'search header
If Not f Is Nothing Then 'got a match?
Set rng = f.CurrentRegion
Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1) 'exclude header row
rng.Copy wsDest.Range("A1") 'copy to specific location
End If
End Sub