none
Excel Console file spilit RRS feed

  • Question

  • Hello team

    Getting error while run the macro

    in      Set rngData = rngData.Offset(1, 0).Resize(rngData.Rows.Count - 1, 1) - error appearing as run time error 1004 (application defined - subject defined error)

    and need to save the file with two different format xlsx and csv. please do the need ful. thanks

    Sub console file_spilit_xlsx & csv()

    Sheets("Data").Select
        Range("E:F,R:S,W:W").Select
        Selection.NumberFormat = "m/d/yyyy"
        
        'Application.Range("rng").Select
        'Selection.AutoFilter
        
        ActiveSheet.Range("rng").AutoFilter Field:=21, Criteria1:="<0", _
            Operator:=xlAnd
        'set range values
        
        Cells(1, 21).Select
        GetFilteredRangeTopRow = Range(Rows(HeaderRow + 2), Rows(Rows.Count)).SpecialCells(xlCellTypeVisible)(21).Select
        ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "-1"
        Selection.Copy
        ActiveCell.Offset(0, -1).Select
        Range(Selection, Selection.End(xlDown)).Select
        
        Selection.SpecialCells(xlCellTypeVisible).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlMultiply, _
            SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        ActiveCell.Offset(0, 1).ClearContents
        
        Selection.AutoFilter
        
        Cells(1, 1).Select
        
        ActiveSheet.Previous.Activate

        'Copy the columns O & C Data and paste to txt file
         'Export is based on the value in the desired column
         Dim myCell As Range
         Dim mySht As Worksheet
         Dim shtNew As Worksheet
         Dim myins As String
         Dim myName As String
         Dim mymonth As String
         Dim myyear As String
         Dim rngData As Range
         Dim myShtName As String
         Dim KeyCol As String
         Dim KeyCol2 As String
         
         Application.DisplayAlerts = False
         Application.ScreenUpdating = False
         Application.CutCopyMode = False
            
         
         myins = ActiveSheet.Name
         ActiveSheet.Next.Activate
         myShtName = ActiveSheet.Name
         Set mySht = ActiveSheet
         KeyCol = "O"
         KeyCol2 = "C"

         Set rngData = Intersect(mySht.UsedRange, mySht.Range(KeyCol & "1").EntireColumn).Cells
         Set rngData = rngData.Offset(1, 0).Resize(rngData.Rows.Count - 1, 1)
        
         For Each myCell In rngData
             On Error GoTo NoSheet
             myName = Worksheets(myCell.Value & "_" & mySht.Cells(myCell.Row, KeyCol2).Value).Name
              GoTo SheetExists:
    NoSheet:
             Set shtNew = Worksheets.Add(After:=Worksheets(2))
             shtNew.Name = myCell.Value & "_" & mySht.Cells(myCell.Row, KeyCol2).Value
             With myCell.CurrentRegion
                 .AutoFilter Field:=Range(KeyCol & "1").Column - .Column + 1, Criteria1:=myCell.Value
                 .AutoFilter Field:=Range(KeyCol2 & "1").Column - .Column + 1, Criteria1:=mySht.Cells(myCell.Row, KeyCol2).Value
                 .SpecialCells(xlCellTypeVisible).Copy _
                         shtNew.Range("A1")
                 shtNew.Cells.EntireColumn.AutoFit
                 .AutoFilter
             End With
             Resume
    SheetExists:
         Next myCell
         
         
         mymonth = Month(Date)
         myyear = Year(Date)


         For Each shtNew In ActiveWorkbook.Worksheets
          If shtNew.Name <> myShtName And shtNew.Name <> myins Then
          
          '   If shtNew.Name <> myShtName Then
                 shtNew.Move
                 Application.DisplayAlerts = False
                 ActiveWorkbook.SaveAs "C:\Output\" & ActiveSheet.Name & _
                 "TR" & Format(DateSerial(myyear, mymonth - 1, 1), "MMMM-yyyy") & ".csv", FileFormat:=xlCSV


                 ActiveWorkbook.SaveAs "C:\Output\" & ActiveSheet.Name & _
                 "TR" & Format(DateSerial(myyear, mymonth - 1, 1), "MMMM-yyyy") & ".xlsx", FileFormat:=xlxlsx             ActiveWorkbook.Close
                 
                 
             End If
         Next shtNew
         
         ActiveSheet.Previous.Select
       
         
            
     End Sub

    Thursday, March 20, 2014 5:56 PM

All replies

  • Run time error while run the macro on below code as i wanted to take visible cell for used range but the code was taken entire rows.....

    Set rngData = rngData.Offset(1, 0).Resize(rngData.Rows.Count - 1, 1)

    Thanks

    Saurabh

    Saturday, March 22, 2014 11:05 AM