VBA copy data in range

[MYMunshi]

Hi Everyone

I need some help please on a VBA script I've done for copying over data from four separate tabs in a workbook into one single tab.

The spreadsheet containing the script is linking data from a bog standard report which is downloaded from a BI system. There are four tabs from where the data is being copied from: each tab is basically mapping each cell from that BI report using IF(ISBLANK("BI Report"A2). So there's a lot of blanks (but with IF(ISBLANK) formulas in them). Each respective tab then uses a UNIQUE function to tidy all that data up, which is where the range of data is trying to be copied, then pasted into the 'Working Table'. So on some days, a tab may have 21 lines, on the other days, it may have only 1 line.

The script works perfectly fine when there's more than 1 line, but it doesn't work when:

1) there is no data in the starting cell, and / or,
2) there is only one line of data in the starting cell.

That's partly because of the way the script is written: go all the way across to the last column with data, then all the way down with the last row of data.

I'm not the best when it comes to Macros and VBA, but I was hoping if someone could please help me code this script in a way where:

1) If the starting cell in any of the four tabs is blank (e.g. if AG4 in "Cancellations" is blank), skip to the next tab
2) If there is only one line of data in the starting cell, select everything in that one row to the end of the range then move to the next tab

My script is as follows (it's a continuous script), with the problem part of the script marked. Maybe it should have been segregated better with separated tabs, but as you can see, I'm not the best with macros.

I'd really appreciate any help please? Thanks so much in advance.

Sub copy_Data()
'
' copy_Data Macro
' This part of the macro copies the data from the Cancellations, T15, Worst T3, and Shortforms tabs.

CarryOn = MsgBox("Have you checked the Worst T3 tab to ensure there is a minimum of two trains for T3 failures (and are you happy with the fails limit)?", vbYesNo, "T3 Limits")
If CarryOn = vbYes Then

    Application.ScreenUpdating = False
  
    Sheets("Working Table").Select
    Range("A5").Select

' PROBLEM STARTS FROM HERE
  
Sheets("Cancellations").Select
    Range("AG4").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown).Offset(-1, 0)).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("Working Table").Select
    Range("A5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A5").Select
    Range("A5").End(xlDown).Offset(1, 0).Select
  
    Sheets("T15").Select
    Range("O5").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown).Offset(-1, 0)).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("Working Table").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A5").Select
    Range("A5").End(xlDown).Offset(1, 0).Select
  
    Sheets("Worst T3").Select
    Range("N5").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("Working Table").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A5").Select
    Range("A5").End(xlDown).Offset(1, 0).Select

    Sheets("Shortforms").Select
    Range("C4").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("Working Table").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A5").

' PROBLEM ENDS HERE
  
' Filtering Macro
' This part of the macro filters based on Train and Start Times.

    ActiveWorkbook.Worksheets("Working Table").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Working Table").AutoFilter.Sort.SortFields.Add2 Key _
        :=Range("A4"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Working Table").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("Working Table").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Working Table").AutoFilter.Sort.SortFields.Add2 Key _
        :=Range("B4"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Working Table").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
  
' MergeCells
' This part of the macro merges the cells based on duplicates in the Trains Column and the Start Times.

Dim rng As Range, xCell As Range, WorkRng As Range
Dim xRows As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set WorkRng = ActiveWorkbook.ActiveSheet.Range("A1:A250, C1:C250")
xRows = WorkRng.Rows.Count
For Each rng In WorkRng.Columns
    For i = 1 To xRows - 1
        For j = i + 1 To xRows
            If rng.Cells(i, 1).Value <> rng.Cells(j, 1).Value Then
                Exit For
            End If
        Next
        With WorkRng.Parent.Range(rng.Cells(i, 1), rng.Cells(j - 1, 1))
            .Merge
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        i = j - 1
    Next
Next


' Unmerge top cells
' This part of the macro unmerges the cells in the top part of the workbook.

    Range("A1:I3").Select
    Range("I3").Activate
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.UnMerge


' deldate Macro
' This macro deletes the populated cell in A1

    Range("A1").Select
    Selection.ClearContents

' datemacro Macro
' This macro produces a drop down for the date and day to be displayed.

    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=DATE"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "=IF(ISBLANK(RC[1]),"""",RC[1])"
    Range("B3").Select
    Selection.NumberFormat = "d-mmm"


' Highlight Date Cell
' This part of the macro highlights the date cell as a reminder that the date needs populating.

    Range("B3").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=LEN(TRIM(B3))=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 8420607
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False


' Add border to table in range

    Range("I4").Select
    Range("I4", Range("I1000").End(xlUp)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    ActiveWindow.SmallScroll Down:=-48
    Range("I4").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=3
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    ActiveWindow.LargeScroll ToRight:=-1
    ActiveWindow.SmallScroll Down:=-51
    Range("A5").Select


End If
 
End Sub