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

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

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

CodePudding user response：

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