简体   繁体   中英

Workbook saves code delete tabs before save

Sorry for the oddly worded question. I have code (below) that creates new sheets based on column data. After the sheets are created VBA copies and pastes every row from the master sheet into the category sheet. I just want excel to save the.csv file and close. It closes but only keeps the last sheet. Is this due to it being a.csv file? If I manually Save As and convert to.xlsx then the columns remain. But I tried adding VBA code to do the same thing and it just saved an empty.xlsx file. I'm not sure what to do...

在此处输入图像描述

Sub Loading_Summary_Breakout()
    
    'Prevents Clipboard Pop-up from appearing.
    Application.DisplayAlerts = False
    
    'Prevents screen flicker and makes the macro run faster.
    Application.ScreenUpdating = False
    
    'Opens Loading Summary workbook.
    Workbooks.Open Filename:=Environ("USERPROFILE") & "\Dropbox (Gotham Enterprise)\Operations Management\#MASTER SCHEDULE\Shop Schedule V4\Loading Summary.csv"
    Workbooks("Loading Summary.csv").Activate
   
    Call DeleteRowsSpecialChartrs
    
    Dim cell As Range, v
    Dim SheetName As String, wb As Workbook, ws As Worksheet
           
    Set ws = ActiveSheet
    Set wb = ws.Parent
    
    'Creates new worksheet/tab for every unique value in Column B (Customer Code Column)
    For Each cell In ws.Range(ws.Range("B2"), ws.Range("B" & Rows.Count).End(xlUp)).Cells
        v = cell.Value
        If Len(v) > 0 Then cell.EntireRow.Range("A1:O1").Copy _
             GetSheet(v, wb).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        
    Next
      
    Call DeleteDuplicates
       
    ActiveWorkbook.Save

    Application.ScreenUpdating = True

End Sub

'Return a named sheet in wb (or create if doesn't exist)
Private Function GetSheet(ByVal SheetName As String, wb As Workbook)
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = wb.Worksheets(SheetName)
    On Error GoTo 0
    If ws Is Nothing Then
        Set ws = wb.Worksheets.Add(after:=wb.Sheets(wb.Sheets.Count))
        ws.Name = SheetName
    End If
    Set GetSheet = ws
End Function

Public Sub DeleteRowsSpecialChartrs()
    Dim rng As Range
    Dim pos As Integer
    Set rng = ActiveSheet.Range("B:B")
    
    For i = rng.Cells.Count To 1 Step -1
        pos = InStr(LCase(rng.Item(i).Value), LCase("/"))
        If pos > 0 Then
            rng.Item(i).EntireRow.Delete
        End If
    Next i
End Sub

Public Sub DeleteDuplicates()

    Dim ws As Worksheet
    Dim wkbk1 As Workbook
    Dim w As Long

    Set wkbk1 = Workbooks("Loading Summary.csv")

    wkbk1.Activate

    With wkbk1

        For w = 1 To .Worksheets.Count

            With Worksheets(w)

                .Range("A:O").RemoveDuplicates Columns:=1, Header:=xlYes

            End With

        Next w

    End With
End Sub

在此处输入图像描述 I wonder what the text in this message means...

I's the text you see when you 'Save As'/'CSV'.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM