Hello,

Need help to fix a code. I am trying to copy all the information from DFG, Geo tab of thisworkbook to Created workbook("DFG_" $environ("username"), doing so I am getting and subscript out of range error. I have underlined the code statement which seems to be incorrect.

Private Sub DFG_Exp_Click()
Application.FileDialog(msoFileDialogFolderPicker).InitialFileName = "I:\Analytical_Services\Public\"
FldrShow = Application.FileDialog(msoFileDialogFolderPicker).Show
If FldrShow <> 0 Then
    FldrSel = Trim(Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1))
    If Right(FldrSel, 1) = "\" Then
        FldrSel = Left(FldrSel, Len(FldrSel) - 1)
    End If
Set newbook = Workbooks.Add
    With newbook
    Worksheets.Add
       .Sheets.Add().Name = "Exception"
       .Sheets.Add().Name = "Geo"
       .Sheets.Add().Name = "DFG"
      
    
    newbook.SaveAs Filename:=FldrSel & "\" & "DFG_" & Environ$("UserName") & ".xls"

    End With
    DFG = "DFG_" & Environ$("UserName")
    row_cnt = ThisWorkbook.Sheets("DFG").UsedRange.Rows.Count
    ThisWorkbook.Sheets("DFG").Range(Cells(5, 1), Cells(row_cnt, 146)).Copy
    'ActiveSheet.Paste
    With Workbooks("DFG").Sheets("DFG").Range("A1")
        .PasteSpecial Paste:=xlPasteFormats
        .PasteSpecial Paste:=xlPasteValues
    End With
    
    row_cnt = ThisWorkbook.Sheets("Geo").UsedRange.Rows.Count
    ThisWorkbook.Sheets("Geo").Range(Cells(1, 1), Cells(row_cnt, 4)).Copy
    
    With Workbooks("DFG").Sheets("Geo").Range("A1")
    .PasteSpecial Paste:=xlPasteFormats
    .PasteSpecial Paste:=xlValues
    End With
End If
End Sub