Copy sheet trong file thành file riêng biệt

Liên hệ QC
Nhưng ý bạn là thế nào? Nếu đã có thì không tách hay xóa sheet đó và cập nhật lại dữ liệu mới hay không làm gì cả...
Ui. Em cảm ơn các bác nhiều ah.
Các bác thật tuyệt. Các bác cho e hỏi thêm chút.
Nếu e muốn có dòng tổng số tiền cần chi cho mỗi chi nhánh ở cuối cột số tiền trong mỗi sheet con mới tạo ra thì có đc k ah. Nếu đc thì code cần thêm gì các bác giúp e với ah.
E chân thành cảm ơn.
 
Ui. Em cảm ơn các bác nhiều ah.
Các bác thật tuyệt. Các bác cho e hỏi thêm chút.
Nếu e muốn có dòng tổng số tiền cần chi cho mỗi chi nhánh ở cuối cột số tiền trong mỗi sheet con mới tạo ra thì có đc k ah. Nếu đc thì code cần thêm gì các bác giúp e với ah.
E chân thành cảm ơn.
Bạn xem code phía dưới.
Dạ xóa sheet đó và cập nhật lại dữ liệu mới
Cám ơn anh nha;)
Vậy bạn sửa code lại thế này.
Mã:
Public Sub GPE()
    Dim Dic As Object, sArr(), Ws As Worksheet, i As Integer, Rng1 As Range, Rng2 As Range, n As Long
Application.ScreenUpdating = False
sArr() = Sheets("Tong hop").Range("B4:F" & Sheets("Tong hop").Range("A65000").End(xlUp).Row).Value
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Tong hop")
    .Range("N1").Value = .Range("B3").Value
    Set Rng1 = .Range("A65000").End(xlUp).Offset(1).Resize(7, 6)
    For i = 1 To UBound(sArr, 1)
        If Not Dic.exists(sArr(i, 1)) Then
            Dic.Add sArr(i, 1), ""
            .Range("N2").Value = sArr(i, 1)
            If WsExit(sArr(i, 1)) Then
                Set Ws = Sheets(sArr(i, 1))
                Ws.UsedRange.Clear
            Else
                 Set Ws = Worksheets.Add(, Sheets("Tong hop"))
            End If
            Ws.Name = sArr(i, 1)
            .Range("A3:F" & .Range("A65000").End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, _
                    CriteriaRange:=.Range("N1:N2"), CopyToRange:=Ws.Range("A3:F3"), Unique:=False
            Ws.Range("A4:A" & Ws.Range("A65000").End(xlUp).Row).Value = [row(r:r)]
            Ws.Range("A1:F1").Merge: Ws.Range("A2:F2").Merge
            Ws.Range("A1:F1").HorizontalAlignment = xlCenter
            Ws.Range("A1:F1").VerticalAlignment = xlCenter
            Ws.Range("A2:F2").HorizontalAlignment = xlCenter
            Ws.Range("A2:F2").VerticalAlignment = xlCenter
            Ws.Range("A1").Value = .Range("B1").Value
            Ws.Range("A2").Value = sArr(i, 1)
            Ws.Range("A65000").End(xlUp).Offset(1, 3).Value2 = "T" & ChrW(7893) & "ng c" & ChrW(7897) & "ng:"
            Ws.Range("A65000").End(xlUp).Offset(1, 4).Formula = "=SUM(R[" & -(Ws.Range("A65000").End(xlUp).Row - 3) & "]C:R[-1]C)"
            Ws.Range("A65000").End(xlUp).Offset(1).Resize(, 6).Borders.LineStyle = 1
            Ws.Columns("A:F").EntireColumn.AutoFit
            Set Rng2 = Ws.Range("A65000").End(xlUp).Offset(2)
            Rng1.Copy Rng2
        End If
    Next i
    .Range("N1:N2").ClearContents
End With
    Dim Wb As Workbook
Sheets(Dic.Keys).Move
'Set Wb = ActiveWorkbook
'Wb.SaveAs Filename:=ThisWorkbook.Path & "\" & ThisWorkbook.Sheets(1).Name & ".xls", FileFormat:=52
'Wb.Close False
Set Dic = Nothing
Application.ScreenUpdating = True
MsgBox "Da xuat xong"
End Sub
Public Function WsExit(ByVal wsName As String) As Boolean
    On Error Resume Next
    WsExit = CBool(Len(Worksheets(wsName).Name) > 0)
End Function
 
Bạn xem code phía dưới.

Vậy bạn sửa code lại thế này.
Mã:
Public Sub GPE()
    Dim Dic As Object, sArr(), Ws As Worksheet, i As Integer, Rng1 As Range, Rng2 As Range, n As Long
Application.ScreenUpdating = False
sArr() = Sheets("Tong hop").Range("B4:F" & Sheets("Tong hop").Range("A65000").End(xlUp).Row).Value
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Tong hop")
    .Range("N1").Value = .Range("B3").Value
    Set Rng1 = .Range("A65000").End(xlUp).Offset(1).Resize(7, 6)
    For i = 1 To UBound(sArr, 1)
        If Not Dic.exists(sArr(i, 1)) Then
            Dic.Add sArr(i, 1), ""
            .Range("N2").Value = sArr(i, 1)
            If WsExit(sArr(i, 1)) Then
                Set Ws = Sheets(sArr(i, 1))
                Ws.UsedRange.Clear
            Else
                 Set Ws = Worksheets.Add(, Sheets("Tong hop"))
            End If
            Ws.Name = sArr(i, 1)
            .Range("A3:F" & .Range("A65000").End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, _
                    CriteriaRange:=.Range("N1:N2"), CopyToRange:=Ws.Range("A3:F3"), Unique:=False
            Ws.Range("A4:A" & Ws.Range("A65000").End(xlUp).Row).Value = [row(r:r)]
            Ws.Range("A1:F1").Merge: Ws.Range("A2:F2").Merge
            Ws.Range("A1:F1").HorizontalAlignment = xlCenter
            Ws.Range("A1:F1").VerticalAlignment = xlCenter
            Ws.Range("A2:F2").HorizontalAlignment = xlCenter
            Ws.Range("A2:F2").VerticalAlignment = xlCenter
            Ws.Range("A1").Value = .Range("B1").Value
            Ws.Range("A2").Value = sArr(i, 1)
            Ws.Range("A65000").End(xlUp).Offset(1, 3).Value2 = "T" & ChrW(7893) & "ng c" & ChrW(7897) & "ng:"
            Ws.Range("A65000").End(xlUp).Offset(1, 4).Formula = "=SUM(R[" & -(Ws.Range("A65000").End(xlUp).Row - 3) & "]C:R[-1]C)"
            Ws.Range("A65000").End(xlUp).Offset(1).Resize(, 6).Borders.LineStyle = 1
            Ws.Columns("A:F").EntireColumn.AutoFit
            Set Rng2 = Ws.Range("A65000").End(xlUp).Offset(2)
            Rng1.Copy Rng2
        End If
    Next i
    .Range("N1:N2").ClearContents
End With
    Dim Wb As Workbook
Sheets(Dic.Keys).Move
'Set Wb = ActiveWorkbook
'Wb.SaveAs Filename:=ThisWorkbook.Path & "\" & ThisWorkbook.Sheets(1).Name & ".xls", FileFormat:=52
'Wb.Close False
Set Dic = Nothing
Application.ScreenUpdating = True
MsgBox "Da xuat xong"
End Sub
Public Function WsExit(ByVal wsName As String) As Boolean
    On Error Resume Next
    WsExit = CBool(Len(Worksheets(wsName).Name) > 0)
End Function
Em làm được rồi các bác ah,
Em cảm ơn các bác nhiều,
Cho em hỏi ngoài lề chút, để làm được như các bác thì em cần học thêm lớp đào tạo nào và ở đâu chất lượng vậy ah, em chỉ có thể học online thôi vì không có điều kiện tham gia offline ah, excel cơ bản em cũng ok chút chút rồi ah. hi
 
Em làm được rồi các bác ah,
Em cảm ơn các bác nhiều,
Cho em hỏi ngoài lề chút, để làm được như các bác thì em cần học thêm lớp đào tạo nào và ở đâu chất lượng vậy ah, em chỉ có thể học online thôi vì không có điều kiện tham gia offline ah, excel cơ bản em cũng ok chút chút rồi ah. hi
Tôi chưa từng tham gia học lớp nào về vba. Nếu thời gian rảnh lên gpe xem các anh em hỏi nhau và trả lời, kèm theo sự nhiệt tình giúp đỡ các thành viên tự động sau một khoản thời gian thì sẽ được thôi.9
 
Tôi chưa từng tham gia học lớp nào về vba. Nếu thời gian rảnh lên gpe xem các anh em hỏi nhau và trả lời, kèm theo sự nhiệt tình giúp đỡ các thành viên tự động sau một khoản thời gian thì sẽ được thôi.9
Ngưỡng mộ bác quá. Em có thêm động lực để mầy mò. Một lần nữa cảm ơn bác.
 
Tôi chưa từng tham gia học lớp nào về vba. Nếu thời gian rảnh lên gpe xem các anh em hỏi nhau và trả lời, kèm theo sự nhiệt tình giúp đỡ các thành viên tự động sau một khoản thời gian thì sẽ được thôi.9
Bạn giúp mình vân đề này với.
Mình có 1 sheet, trong sheet này có 5 table dữ liệu (table có đặt tên, và có thể thêm nữa), giờ mình muốn sau khi nhập liệu cho 5 table này, khi nhấn vào xuất file, thì mỗi bảng table sẽ vào 1 sheet của file khác (vidu, file bang gia.xls), ở đây có 5 table, khi xuất ra thì table 1 sẽ là sheet tên gia 1, table 2 sẽ là sheet gia 2,…
và chỉ lấy 1 số cột, bỏ các cột gia von, km1, km2, km3, còn lại lấy hết
Xem giúp mình file đính kèm.
Xin cám ơn
 

File đính kèm

  • Book2.xlsx
    18 KB · Đọc: 13
Lần chỉnh sửa cuối:
BẠN GIÚP MÌNH VÂN ĐỀ NÀY VỚI.
MÌNH CÓ 1 SHEET, TRONG SHEET NÀY CÓ 5 TABLE DỮ LIỆU (TABLE CÓ ĐẶT TÊN, VÀ CÓ THỂ THÊM NỮA), GIỜ MÌNH MUỐN SAU KHI NHẬP LIỆU CHO 5 TABLE NÀY, KHI NHẤN VÀO XUẤT FILE, THÌ MỖI BẢNG TABLE SẼ VÀO 1 SHEET CỦA FILE KHÁC (VIDU, FILE BANG GIA.XLS), Ở ĐÂY CÓ 5 TABLE, KHI XUẤT RA THÌ TABLE 1 SẼ LÀ SHEET TÊN GIA 1, TABLE 2 SẼ LÀ SHEET GIA 2,…
VÀ CHỈ LẤY 1 SỐ CỘT, BỎ CÁC CỘT GIA VON, KM1, KM2, KM3, CÒN LẠI LẤY HẾT
XEM GIÚP MÌNH FILE ĐÍNH KÈM.
XIN CÁM ƠN
Trước hết bạn nên xem lại nội quy đi, bạn đã vi phạm mục II phần 3. Phải sửa nội dung bài viết đúng quy định sẽ được trợ giúp ngay.
 
Bạn giúp mình vân đề này với.
Mình có 1 sheet, trong sheet này có 5 table dữ liệu (table có đặt tên, và có thể thêm nữa), giờ mình muốn sau khi nhập liệu cho 5 table này, khi nhấn vào xuất file, thì mỗi bảng table sẽ vào 1 sheet của file khác (vidu, file bang gia.xls), ở đây có 5 table, khi xuất ra thì table 1 sẽ là sheet tên gia 1, table 2 sẽ là sheet gia 2,…
và chỉ lấy 1 số cột, bỏ các cột gia von, km1, km2, km3, còn lại lấy hết
Xem giúp mình file đính kèm.
Xin cám ơn
Bạn dùng thử code này, nhưng nó sẽ không có tiêu đề khi tạo qua file mới. Muốn có tiêu đề thì bạn đặt lại Name "BANGGIA10" có luôn phần tiêu đề, tương tự cho các Name khác.
Mã:
Sub GPE()
Dim fNameAndPath As Variant, Wb As Workbook, sh As Worksheet, i As Integer
fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Select File To Be Opened")
If fNameAndPath = False Then Exit Sub
Set Wb = Workbooks.Open(fNameAndPath)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
With Wb
    For i = 1 To 5
        If WsExit(Wb, "Gia " & i) Then
            Set sh = Wb.Sheets("Gia " & i)
            sh.UsedRange.Clear
        Else
            Set sh = .Worksheets.Add
            sh.Name = "Gia " & i
        End If
        ThisWorkbook.Sheets("Sheet1").Range("BANGGIA" & (i + 9)).Copy sh.Range("A1")
        sh.Range("F:F,J:L").EntireColumn.Delete
    Next i
    .Close savechanges:=True
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Da thuc hien xong", vbExclamation, "---GPE---"
End Sub
Public Function WsExit(Wb As Workbook, ByVal wsName As String) As Boolean
    On Error Resume Next
    WsExit = CBool(Len(Wb.Worksheets(wsName).Name) > 0)
End Function
 
Bạn dùng thử code này, nhưng nó sẽ không có tiêu đề khi tạo qua file mới. Muốn có tiêu đề thì bạn đặt lại Name "BANGGIA10" có luôn phần tiêu đề, tương tự cho các Name khác.
Mã:
Sub GPE()
Dim fNameAndPath As Variant, Wb As Workbook, sh As Worksheet, i As Integer
fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Select File To Be Opened")
If fNameAndPath = False Then Exit Sub
Set Wb = Workbooks.Open(fNameAndPath)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
With Wb
    For i = 1 To 5
        If WsExit(Wb, "Gia " & i) Then
            Set sh = Wb.Sheets("Gia " & i)
            sh.UsedRange.Clear
        Else
            Set sh = .Worksheets.Add
            sh.Name = "Gia " & i
        End If
        ThisWorkbook.Sheets("Sheet1").Range("BANGGIA" & (i + 9)).Copy sh.Range("A1")
        sh.Range("F:F,J:L").EntireColumn.Delete
    Next i
    .Close savechanges:=True
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Da thuc hien xong", vbExclamation, "---GPE---"
End Sub
Public Function WsExit(Wb As Workbook, ByVal wsName As String) As Boolean
    On Error Resume Next
    WsExit = CBool(Len(Wb.Worksheets(wsName).Name) > 0)
End Function

Cám ơn bạn,
Nhưng cho mình hỏi, đặt tiêu đề thì đặt bên file nguồn hay sao, với file khi xuất ra nó kéo theo công thức, có cách nào nó chỉ lấy value thôi, không cần lấy công thức.
Một lần nữa cảm ơn bạn.
 
Cám ơn bạn,
Nhưng cho mình hỏi, đặt tiêu đề thì đặt bên file nguồn hay sao, với file khi xuất ra nó kéo theo công thức, có cách nào nó chỉ lấy value thôi, không cần lấy công thức.
Một lần nữa cảm ơn bạn.
Bạn thử lại code này.
Mã:
Sub GPE()
Dim fNameAndPath As Variant, Wb As Workbook, sh As Worksheet, i As Integer
fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Select File To Be Opened")
If fNameAndPath = False Then Exit Sub
Set Wb = Workbooks.Open(fNameAndPath)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
With Wb
    For i = 1 To 5
        If WsExit(Wb, "Gia " & i) Then
            Set sh = Wb.Sheets("Gia " & i)
            sh.UsedRange.Clear
        Else
            Set sh = .Worksheets.Add
            sh.Name = "Gia " & i
        End If
        ThisWorkbook.Sheets("Sheet1").Range("A1:R1").Copy sh.Range("A1")
        ThisWorkbook.Sheets("Sheet1").Range("BANGGIA" & (i + 9)).Copy sh.Range("A2")
        sh.UsedRange.Value = sh.UsedRange.Value
        sh.Range("F:F,J:L").EntireColumn.Delete
    Next i
    .Close savechanges:=True
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Da thuc hien xong", vbExclamation, "---GPE---"
End Sub
Public Function WsExit(Wb As Workbook, ByVal wsName As String) As Boolean
    On Error Resume Next
    WsExit = CBool(Len(Wb.Worksheets(wsName).Name) > 0)
End Function
 
Bạn giúp mình vân đề này với.
Mình có 1 sheet, trong sheet này có 5 table dữ liệu (table có đặt tên, và có thể thêm nữa), giờ mình muốn sau khi nhập liệu cho 5 table này, khi nhấn vào xuất file, thì mỗi bảng table sẽ vào 1 sheet của file khác (vidu, file bang gia.xls), ở đây có 5 table, khi xuất ra thì table 1 sẽ là sheet tên gia 1, table 2 sẽ là sheet gia 2,…
và chỉ lấy 1 số cột, bỏ các cột gia von, km1, km2, km3, còn lại lấy hết
Xem giúp mình file đính kèm.
Xin cám ơn
Góp ý cho bạn:
1/ Tôi hkông rõ bạn theo dõi với mục đích để làm gì?
2/ Theo tôi thì nên có 1 cột là số phiếu, số hóa đơn hay số hợp đồng và chỉ sử dụng với 1 tiêu đề thì sẽ thuận lợi rất nhiều mặt, ví dụ:
- Dựa vào cột này để lọc hoặc xuất File thì code sẽ ngắn gọn hơn.
- Có thể Dùng PivotTable để tổng hợp bất kỳ thứ gì.
- Có thể truy vấn lại bất kỳ số phiếu, số hóa đơn hay số hợp đồng gì đó?
 
Góp ý cho bạn:
1/ Tôi hkông rõ bạn theo dõi với mục đích để làm gì?
2/ Theo tôi thì nên có 1 cột là số phiếu, số hóa đơn hay số hợp đồng và chỉ sử dụng với 1 tiêu đề thì sẽ thuận lợi rất nhiều mặt, ví dụ:
- Dựa vào cột này để lọc hoặc xuất File thì code sẽ ngắn gọn hơn.
- Có thể Dùng PivotTable để tổng hợp bất kỳ thứ gì.
- Có thể truy vấn lại bất kỳ số phiếu, số hóa đơn hay số hợp đồng gì đó?
À, vì bảng này dữ liệu thay đổi thường xuyên, sẽ cập nhật mỗi ngày, khi cập nhật xong mình phải tách ra theo mỗi Table là mỗi sheet để gửi cho các nơi, các nơi dựa vào bảng đó để bán giá đó.
 
À, vì bảng này dữ liệu thay đổi thường xuyên, sẽ cập nhật mỗi ngày, khi cập nhật xong mình phải tách ra theo mỗi Table là mỗi sheet để gửi cho các nơi, các nơi dựa vào bảng đó để bán giá đó.
Việc này thì chỉ cần dựa vào cột này (cột là số phiếu, số hóa đơn hay số hợp đồng) thêm code tách sheet và muốn gán tiêu đề gì giống như một cái hóa đơn thì gán.
Bạn có thể tham khảo cách làm trong File sau.
 

File đính kèm

  • TACH SHEET.xls
    356.5 KB · Đọc: 12
Lần chỉnh sửa cuối:
Bạn thử lại code này.
Mã:
Sub GPE()
Dim fNameAndPath As Variant, Wb As Workbook, sh As Worksheet, i As Integer
fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Select File To Be Opened")
If fNameAndPath = False Then Exit Sub
Set Wb = Workbooks.Open(fNameAndPath)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
With Wb
    For i = 1 To 5
        If WsExit(Wb, "Gia " & i) Then
            Set sh = Wb.Sheets("Gia " & i)
            sh.UsedRange.Clear
        Else
            Set sh = .Worksheets.Add
            sh.Name = "Gia " & i
        End If
        ThisWorkbook.Sheets("Sheet1").Range("A1:R1").Copy sh.Range("A1")
        ThisWorkbook.Sheets("Sheet1").Range("BANGGIA" & (i + 9)).Copy sh.Range("A2")
        sh.UsedRange.Value = sh.UsedRange.Value
        sh.Range("F:F,J:L").EntireColumn.Delete
    Next i
    .Close savechanges:=True
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Da thuc hien xong", vbExclamation, "---GPE---"
End Sub
Public Function WsExit(Wb As Workbook, ByVal wsName As String) As Boolean
    On Error Resume Next
    WsExit = CBool(Len(Wb.Worksheets(wsName).Name) > 0)
End Function
Rất cảm ơn bạn.
Để mình thử chỉnh thêm 1 cái nữa là: khi xuất file mới sẽ đặt tên sheet luôn (hiện tại Gia 1, Gia 2, Gia 3,...), để mình thử chuyển nó thành Giá Loa, Giá Tivi, Giá Tai Nghe,...
Bài đã được tự động gộp:

Việc này thì chỉ cần dựa vào cột này (cột là số phiếu, số hóa đơn hay số hợp đồng) thêm code tách sheet và muốn gán tiêu đề gì giống như một cái hóa đơn thì gán.
Bạn có thể tham khảo cách làm trong File sau.
Cám ơn bạn,
Để mình tham khảo thử, rồi coi có áp vô trường hợp mình được không.
 
Lần chỉnh sửa cuối:
Bạn thử lại code này.
Mã:
Sub GPE()
Dim fNameAndPath As Variant, Wb As Workbook, sh As Worksheet, i As Integer
fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Select File To Be Opened")
If fNameAndPath = False Then Exit Sub
Set Wb = Workbooks.Open(fNameAndPath)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
With Wb
    For i = 1 To 5
        If WsExit(Wb, "Gia " & i) Then
            Set sh = Wb.Sheets("Gia " & i)
            sh.UsedRange.Clear
        Else
            Set sh = .Worksheets.Add
            sh.Name = "Gia " & i
        End If
        ThisWorkbook.Sheets("Sheet1").Range("A1:R1").Copy sh.Range("A1")
        ThisWorkbook.Sheets("Sheet1").Range("BANGGIA" & (i + 9)).Copy sh.Range("A2")
        sh.UsedRange.Value = sh.UsedRange.Value
        sh.Range("F:F,J:L").EntireColumn.Delete
    Next i
    .Close savechanges:=True
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Da thuc hien xong", vbExclamation, "---GPE---"
End Sub
Public Function WsExit(Wb As Workbook, ByVal wsName As String) As Boolean
    On Error Resume Next
    WsExit = CBool(Len(Wb.Worksheets(wsName).Name) > 0)
End Function
Cám ơn bạn,
Hiện tại mình áp dụng file thực tế đã chạy ngon lành, có chỉnh sửa 1 chút trong code.
Nhưng lại lòi ra thêm vấn đề khác, là có thể Xuất ra file mới, VD: gom Bảng 1 (Table: BANGGIA1) với Bảng 3 (Table: BANGGIA3) ra Sheet Giá Loa hoặc Bảng 4 với Bảng 6 ra Sheet Giá Amply,....
Một lần nữa xin cám ơn.
 
Bạn thử lại code này.
Mã:
Sub GPE()
Dim fNameAndPath As Variant, Wb As Workbook, sh As Worksheet, i As Integer
fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Select File To Be Opened")
If fNameAndPath = False Then Exit Sub
Set Wb = Workbooks.Open(fNameAndPath)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
With Wb
    For i = 1 To 5
        If WsExit(Wb, "Gia " & i) Then
            Set sh = Wb.Sheets("Gia " & i)
            sh.UsedRange.Clear
        Else
            Set sh = .Worksheets.Add
            sh.Name = "Gia " & i
        End If
        ThisWorkbook.Sheets("Sheet1").Range("A1:R1").Copy sh.Range("A1")
        ThisWorkbook.Sheets("Sheet1").Range("BANGGIA" & (i + 9)).Copy sh.Range("A2")
        sh.UsedRange.Value = sh.UsedRange.Value
        sh.Range("F:F,J:L").EntireColumn.Delete
    Next i
    .Close savechanges:=True
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Da thuc hien xong", vbExclamation, "---GPE---"
End Sub
Public Function WsExit(Wb As Workbook, ByVal wsName As String) As Boolean
    On Error Resume Next
    WsExit = CBool(Len(Wb.Worksheets(wsName).Name) > 0)
End Function
Anh có thể giúp em là: Em muốn gộp table 1,3 thành Sheet GIA1, Table 2,5,6 thành sheet GIA2, table 7,8,9 thành sheet GIA3,.... khi xuất ra file không và file đó chỉ là value không cần công thức.
Cám ơn anh
 
Web KT
Back
Top Bottom