Consulting

Results 1 to 1 of 1

Thread: How to end the last row and save the new file?

  1. #1

    How to end the last row and save the new file?

    Hi
    Can anyone help me to correct the coding error? I am having the problem cannot stop the last row copy & save in new file. Coding highlight in red color.
    My purpose to this macro is to split the data in "pivot" tab into multiple workbook based on currency and split again into multiple worksheet by recipient name in the currency file. Then save the file name as USD and MYR. Result is in each currency file will have different recipient name in multiple worksheet.
    Thank you for help.
    ----------------------------------------------------------------------------------------
    Sub split_Currency_in_workbooks()
    Application.ScreenUpdating = False
    Dim currency_sh As Worksheet
    Set currency_sh = ThisWorkbook.Sheets("Pivot")
    Dim summary_sh As Worksheet
    Set summary_sh = ThisWorkbook.Sheets("Summary")
    Dim nwb As Workbook
    Dim nsh As Worksheet
    'Get the currency split
    summary_sh.Range("A:A").Clear
    currency_sh.AutoFilterMode = False
    currency_sh.Range("K:K").Copy summary_sh.Range("A1")
    summary_sh.Range("A:A").RemoveDuplicates 1, xlYes
    Dim i As Integer
    For i = 2 To Application.CountA(summary_sh.Range("A:A"))
    currency_sh.UsedRange.AutoFilter 11, summary_sh.Range("A" & i).Value
    
    Set nwb = Workbooks.Add
    Set nsh = nwb.Sheets(1)
    
    currency_sh.UsedRange.SpecialCells(xlCellTypeVisible).Copy nsh.Range("A1")
    nsh.UsedRange.EntireColumn.ColumnWidth = 15
    
    ' Split by requester
    'Sub SplitRequester()
    'Declaring constant variables
    Const col = "A"
    Const header_row = 1
    'Assigning initial value as 2, because data transfer will happen from 2nd row onwards
    Const starting_row = 2
    'To declare variable of worksheet type for main sheet, that has data to split
    Dim source_sheet As Worksheet
    'To declare variable of worksheet type for adding required sheets
    Dim destination_sheet As Worksheet
    Dim source_row As Long
    Dim last_row As Long
    Dim destination_row As Long
    'This variable is for changing values in column A, that has recipeint name
    Dim recipient As String
    'Assigning active sheet, that has data to split
    Set source_sheet = ActiveSheet
    'To know the last filled row and activesheet basis on column A, that has data to split
    last_row = source_sheet.Cells(source_sheet.Rows.Count, col).End(xlUp).Row
    For source_row = starting_row To last_row
    recipient = source_sheet.Cells(source_row, col).Value
    Set destination_sheet = Nothing
    On Error Resume Next
    Set destination_sheet = Worksheets(recipient)
    On Error GoTo 0
    If destination_sheet Is Nothing Then
    'To add new sheet, if there is no existing sheet of the given recipient name
    Set destination_sheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    'To assign name to added sheet
    destination_sheet.Name = recipient
    'To add header row to each added sheet
    source_sheet.Rows(header_row).Copy Destination:=destination_sheet.Rows(header_row)
    End If
    'To identify the next available row on destination sheet
    destination_row = destination_sheet.Cells(destination_sheet.Rows.Count, col).End(xlUp).Row + 1
    'Coying rows from active sheet, one by one and pasting to next available line on destination sheet
    source_sheet.Rows(source_row).Copy Destination:=destination_sheet.Rows(destination_row)
    Next source_row
    
    nwb.SaveAs summary_sh.Range("H6").Value & "/" & summary_sh.Range("A" & i).Value & ".xlsx"
    nwb.Close False
    currency_sh.AutoFilterMode = False
    summary_sh.Range("A:A").Clear
    MsgBox "Done"
    
    Next
    End Sub
    Attached Files Attached Files
    Last edited by Aussiebear; 11-26-2021 at 12:20 AM. Reason: Found in another sub forum

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •