Sub Export()
Dim dic As Object, rngSrc As Range, wkbNew As Workbook
Dim aIDs, n As Long
Dim sFolder As String, FileName As String, SheetName As String
sFolder = ThisWorkbook.Path & "\Export_"
Set rngSrc = ThisWorkbook.Worksheets("Sheet8").Range("A1:AL9000")
aIDs = rngSrc.Offset(1).Columns("A:B").Value
Set dic = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
rngSrc.Range("IV1").Value = rngSrc.Range("A1").Value
For n = 1 To UBound(aIDs, 1)
If Len(aIDs(n, 1)) * Len(aIDs(n, 2)) Then
SheetName = aIDs(n, 1): FileName = aIDs(n, 1)
If Not dic.Exists(SheetName) Then
dic.Add SheetName, Empty
Set wkbNew = Workbooks.Add(1)
wkbNew.Sheets(1).Name = SheetName
rngSrc.Range("IV2").Value = "'=" & SheetName
rngSrc.AdvancedFilter 2, rngSrc.Range("IV1:IV2"), wkbNew.Sheets(1).Range("A1")
wkbNew.SaveAs sFolder & FileName, xlOpenXMLWorkbook
wkbNew.Close False
End If
End If
Next
Application.ScreenUpdating = True
rngSrc.Range("IV1:IV2").ClearContents
If dic.Count Then MsgBox "Ða luu " & dic.Count & " workbooks", , "THÔNG BÁO"
End Sub
((
Mình không biết VBA đâu, chẳng qua là trước có nhờ trường hợp này rồi nên giờ thấy giống thì giúp bạn thôi.bạn ơi,dùng VBA ạ, bạn dạy mình với
Có code nào tách nguyên sheet ra và chỉ còn giá trị không bạn ơi
Mình chưa hiểu ý bạn.
Lưu sheet ra 1 workbook riêng, và công thức trong sheet đó thì biến thành giá trị nha
Được.
đa tạ và chờ file bạn gửi
Bạn gửi file mình mới biết như thế nào mà gửi code
thì chuyển cả sheet thôi, đâu cần nội dung trong sheet là gì? mình làm mấy câu lệnh vlookup bảng dữ liệu tổng thôi à
bạn ơi giúp mình với, mình đã chạy file bạn up lên, chỉ cắt được thành 28 file nhỏ, nếu cắt đủ file thì phải là 70 file, bạn xem lại code giúp mình với ạ, mình cảm ơn!
Mình để tách 9000 dòng thôi, nếu dữ liệu bạn nhiều hơn thì sữa chỗ này lại thành số dòng trong file bạn hoặc thành 65000 dòng
Set rngSrc = ThisWorkbook.Worksheets("Sheet8").Range("A1:AL9000")Code đó đã dán gias tri và giữ format rồi mà bạn.
Cảm ơn bạn!
