robinhsoon
Thành viên hoạt động



- Tham gia
- 19/1/16
- Bài viết
- 153
- Được thích
- 11
Xin chào cả nhà GPEX!
Mong cả nhà giúp em một việc ạ..!
HIện tại em có 01 cái macro save File bên dưới... Macro nó chỉ làm việc tại File có chưa Macro thôi, em muốn sửa code lại sao cho khi mình ở bất kỳ File nào chạy nó vẫn chạy và save File đó ạ...
Mong cả nhà giúp đỡ
Cảm ở cả nhà nhiều ạ...!
Sub Save_Data()
Application.DisplayAlerts = False
Dim Wk As Workbook, Wk1 As Workbook
Dim WkName As String, Wk1Name As String
Dim ChuaSheets, TimSh, XoaSheets
Dim filename As String
ChuaSheets = Array("Package Input", "")
Set Wk = ThisWorkbook
WkName = Wk.Name
Set Wk1 = Workbooks.Add
Wk1Name = Wk.Path & "\" & "Data_Goldsun" & ".xlsx"
For Each TimSh In Wk.Worksheets
Windows(WkName).Activate
XoaSheets = Filter(ChuaSheets, TimSh.Name, 1)
If UBound(XoaSheets) <> 0 Then
TimSh.Select
TimSh.Copy after:=Wk1.Sheets(Wk1.Sheets.Count)
End If
Next
ChDir Wk.Path
Wk1.Sheets(Array("sheet1", "sheet2", "sheet3")).Delete
Wk1.SaveAs Wk1Name, xlOpenXMLWorkbook
Wk1.Close
Application.DisplayAlerts = True
End Sub
Mong cả nhà giúp em một việc ạ..!
HIện tại em có 01 cái macro save File bên dưới... Macro nó chỉ làm việc tại File có chưa Macro thôi, em muốn sửa code lại sao cho khi mình ở bất kỳ File nào chạy nó vẫn chạy và save File đó ạ...
Mong cả nhà giúp đỡ
Cảm ở cả nhà nhiều ạ...!
Sub Save_Data()
Application.DisplayAlerts = False
Dim Wk As Workbook, Wk1 As Workbook
Dim WkName As String, Wk1Name As String
Dim ChuaSheets, TimSh, XoaSheets
Dim filename As String
ChuaSheets = Array("Package Input", "")
Set Wk = ThisWorkbook
WkName = Wk.Name
Set Wk1 = Workbooks.Add
Wk1Name = Wk.Path & "\" & "Data_Goldsun" & ".xlsx"
For Each TimSh In Wk.Worksheets
Windows(WkName).Activate
XoaSheets = Filter(ChuaSheets, TimSh.Name, 1)
If UBound(XoaSheets) <> 0 Then
TimSh.Select
TimSh.Copy after:=Wk1.Sheets(Wk1.Sheets.Count)
End If
Next
ChDir Wk.Path
Wk1.Sheets(Array("sheet1", "sheet2", "sheet3")).Delete
Wk1.SaveAs Wk1Name, xlOpenXMLWorkbook
Wk1.Close
Application.DisplayAlerts = True
End Sub