Question

对于措辞古怪的问题表示抱歉。我有下面的代码基于列数据创建新的工作表。在创建工作表之后，VBA将主表中的每一行复制并粘贴到类别表中。我只想要excel保存.csv文件并关闭。它关闭，但仅保留最后一张纸。这是因为它是.csv文件吗？如果我手动另存为并转换为.xlsx，则这些列将保留。但是我尝试添加VBA代码来执行相同的操作，并且它只是保存了一个空的.xlsx文件。我不确定该怎么办...

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

Answer 1

我想知道此消息中的文字是什么意思...

这是您“另存为” /“ CSV”时看到的文本。

工作簿在保存之前保存代码删除选项卡

1 个答案: