Assistance Needed with VBA Code for Copying Data

Hi,

I'm seeking help with a VBA code I've implemented to copy data from the "By Facility" tab to the "CS_export" tab. The code functions correctly when there are multiple line items in the "By Facility" tab; however, it fails to operate when there is only a single line of data present.

I’ve attached an example of how the "By Facility" tab looks in my original file. I would appreciate any guidance or solutions you could provide.

VBA code

Public Sub Export_Supply_Chain()

    Dim wbMaster        As Workbook
    Dim wbNewWorkbook   As Workbook
    
    Dim wsTemplate      As Worksheet
    Dim wsWIP           As Worksheet
    Dim wsDetail        As Worksheet
    Dim wsNewDetail     As Worksheet
    Dim wsCS_Export  As Worksheet
    
    On Error GoTo Error_handler
    
    
    Dim rngTerr         As Range
    Dim rngDistLeads    As Range
    Dim rngCell         As Range
    Dim rngHeader       As Range
    Dim rngCS_Export       As Range
    Dim ChartObj        As Object
    Dim strPath         As String
    Dim strFileName     As String
    Dim strTerr        As String
    Dim strHospital         As String
    'Dim wsTest         As String
    
    Dim strFile         As String
    Dim strSheet        As String
    Dim MyNewBook       As String
    Dim lnSheetName     As Long
    Dim count           As Integer
    Dim Row_Count           As Integer
    Dim DefaultFilePath  As String
    Dim FileSelected As String
    

    
    Dim wbRepsWorkbook        As Workbook
    
    Dim wsTerr          As Worksheet
    Dim wsTest          As Worksheet
    Dim wsAdd          As Worksheet
    Dim wsLooseEstimate  As Worksheet
    
    
Dim rngHeaderNALT       As Range
Dim wsNewALT          As Worksheet
Dim rngHeaderAdd       As Range
Dim wsNewAdd          As Worksheet

Dim rngHeaderALT       As Range
Dim cell                As Range
Dim delRange            As Range

Dim wsNewComp          As Worksheet
Dim rngHeaderComp       As Range

Dim strTerr_train         As String
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = True
    End With
    
    Set wbMaster = ThisWorkbook
    
    strHospital = wbMaster.Worksheets("OS").Range("C4")
    
        With wbMaster
        'Set wsInput = .Sheets("LooseEstimate")
        
        Set wsOutput = .Sheets("By Facility")
        Set wsCS_Export = .Sheets("CS_Export")
        'Set wsOutput_contract = .Sheets("CS_Export")
        
    End With

'Set wbMaster = ActiveWorkbook

wbMaster.Worksheets("CS_Export").Visible = True
wbMaster.Worksheets("CS_Export").Unprotect "ABC"

On Error Resume Next
wbMaster.Worksheets("CS_Export").ShowAllData
On Error GoTo 0

wbMaster.Worksheets("CS_Export").Range("A2:CZ50000").ClearContents

    wbMaster.Worksheets("By Facility").Activate
    wbMaster.Worksheets("By Facility").Unprotect "ABC"
    wbMaster.Worksheets("By Facility").Columns("J:W").Hidden = False

    With wsOutput
    
    On Error Resume Next
.ShowAllData
On Error GoTo 0
    
    .AutoFilterMode = False
.Range("G4", Range("G" & Rows.count).End(xlUp)).AutoFilter Field:=1, Criteria1:=">0"
'On Error Resume Next
.Range("G5", Range("G" & Rows.count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
wbMaster.Worksheets("CS_Export").Range("L2").PasteSpecial xlPasteValues
.Range("J5", Range("J" & Rows.count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
wbMaster.Worksheets("CS_Export").Range("B2").PasteSpecial xlPasteValues

.Range("W5", Range("W" & Rows.count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
wbMaster.Worksheets("CS_Export").Range("C2").PasteSpecial xlPasteValues

.Range("M5", Range("M" & Rows.count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
wbMaster.Worksheets("CS_Export").Range("K2").PasteSpecial xlPasteValues

.Range("O5", Range("O" & Rows.count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
wbMaster.Worksheets("CS_Export").Range("AD2").PasteSpecial xlPasteValues

.Range("P5", Range("P" & Rows.count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
wbMaster.Worksheets("CS_Export").Range("A2").PasteSpecial xlPasteValues

.Range("Q5", Range("Q" & Rows.count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
wbMaster.Worksheets("CS_Export").Range("F2").PasteSpecial xlPasteValues

.Range("R5", Range("R" & Rows.count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
wbMaster.Worksheets("CS_Export").Range("G2").PasteSpecial xlPasteValues

.Range("S5", Range("S" & Rows.count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
wbMaster.Worksheets("CS_Export").Range("Y2").PasteSpecial xlPasteValues

.Range("T5", Range("T" & Rows.count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
wbMaster.Worksheets("CS_Export").Range("BH2").PasteSpecial xlPasteValues

.Range("U5", Range("U" & Rows.count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
wbMaster.Worksheets("CS_Export").Range("T2").PasteSpecial xlPasteValues

.AutoFilterMode = False

'Exit Sub

                    
            
    End With
    
    'With wsCS_Export
    
    Dim i As Long
   
   For i = wsCS_Export.Range("L" & Rows.count).End(xlUp).Row To 2 Step -1
      
     'MsgBox ("Below I with value " & i)
      If (wsCS_Export.Range("AD" & i).Value <> "Set") Then
      'do nothing
      Else
      
      'MsgBox ("Below Else of Set")
      
         If (wsCS_Export.Range("L" & i).Value = 1) Then
         'dp nothing
         Else
            wsCS_Export.Rows(i).Copy
      wsCS_Export.Rows(i).Resize(wsCS_Export.Range("L" & i).Value - 1).Insert
      End If
      End If
      
   Next i
   'End With
    
    
    
    'With wsCS_Export

'wsCS_Export.AutoFilterMode = False

wsCS_Export.Range("A1:CM100000").AutoFilter Field:=30, Criteria1:="Set"
'.Range("A1", Range("AD" & Rows.count).End(xlUp)).AutoFilter Field:=30, Criteria1:="Set"
'On Error Resume Next
'.Range("G5", Range("G" & Rows.count).End(xlUp)).SpecialCells(12).EntireRow.Delete
'wsCS_Export.AutoFilterMode = False

On Error Resume Next
Set rngCS_Export = wsCS_Export.Range("L2:L" & Cells(Rows.count, "L").End(xlUp).Row).Cells.SpecialCells(xlCellTypeVisible)
On Error GoTo 0

Dim c1 As Range

If rngCS_Export Is Nothing Then

'Set rngCS_Export.Value = 1
'Do Nothing as there is no Set in the order

Else

' Setting the value of sets to quantity 1 for each row of set

rngCS_Export.Value = 1

End If

'For Each cell In rngCS_Export
 '       'MsgBox ("Cell value" & cell.Value)
  '      cell.Value = 1
   ' Next cell
    
On Error Resume Next
wbMaster.Worksheets("CS_Export").ShowAllData
On Error GoTo 0
    
    'Exit Sub
    
    'lastRow = wbMaster.Worksheets("CS_Export").Range("L1", Worksheets("CS_Export").Range("L1").End(xlDown)).Rows.count
    'lastRow = wbMaster.Worksheets("CS_Export").Range("L" & src.Rows.count).End(xlUp).Row
    
    'wbMaster.Worksheets("CS_Export").Range("A2:A" & lastRow).Value = "ZNC"
    'wbMaster.Worksheets("CS_Export").Range("G2:G" & lastRow).Value = "N14"
    'wbMaster.Worksheets("CS_Export").Range("Y2:Y" & lastRow).Value = "M007"
    'wbMaster.Worksheets("CS_Export").Range("F2:F" & lastRow).Value = "S2"
    
'Dim rw As Integer

'With wbMaster
        'Set wsNewDetail = .Sheets.Add
      
    
    
    Set wbNewWorkbook = Workbooks.Add
    Set wbNewWorkbook = ActiveWorkbook
    
    With wbNewWorkbook
    
 MyNewBook = wbNewWorkbook.Name
 
 wbMaster.Worksheets("CS_Export").Copy Before:=wbNewWorkbook.Sheets(1)
    
    'ActiveSheet.Paste
    
        '.Range("A1").PasteSpecial xlPasteColumnWidths
        '.PasteSpecial xlPasteValues
        '.PasteSpecial xlPasteFormats
        '.Columns("A:I").EntireColumn.NumberFormat = "@"
        '.Columns("A:I").EntireColumn.AutoFit
        
       

'End With
        
             
    End With
    
    

'..................................................................

'wsNewDetail.Move after:=wbNewWorkbook.Sheets(1)

 wbMaster.Worksheets("CS_Export").Protect "ABC"
 wbMaster.Worksheets("By Facility").Columns("J:W").Hidden = True

wbMaster.Worksheets("By Facility").Protect "ABC"
wbMaster.Worksheets("CS_Export").Visible = False

'wbMaster.Worksheets("Contract").Activate
        
 Dim datim As String
    datim = Format(CStr(Now), "yyyy_mm_dd_hh_mm")
        
        'MsgBox "Came till after date format"
        strFileName = "CS_Export_" & strHospital & "_" & datim
        
        Set wbNewWorkbook = ActiveWorkbook
            
    ActiveWorkbook.Worksheets(1).Activate
    
    
    
    
    With wbNewWorkbook
    'MsgBox ("Before rename")
    'Sheets("Sheet1").Name = "Sheet2"
   ' Sheets("Matching Input").Name = "Sheet1"
    'MsgBox ("After rename")
    
    FileSelected = Application.Dialogs(xlDialogSaveAs).Show(strFileName)
    
    'MsgBox "Value of fileselected " & FileSelected

If Not FileSelected <> "False" Then
'MsgBox "You have cancelled"
wbNewWorkbook.Close False
Set wbNewWorkbook = Nothing
Exit Sub
End If
        
    End With

With Application
        .ScreenUpdating = True
        .DisplayAlerts = False
    End With
    
Exit Sub
    
Error_handler:
MsgBox "An error has occured while processing the file. Please close the file and rerun it, if the problem persists contact the CE support team"
Application.Calculation = xlAutomatic
    
    
End Sub

Screenshot of error message:

Thank you!