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
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.