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

xuannt2014

Thành viên mới
Tham gia ngày
3 Tháng mười 2018
Bài viết
4
Được thích
0
Điểm
13
Tuổi
34
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.
 

giaiphap

Thành viên gạo cội
Tham gia ngày
12 Tháng ba 2007
Bài viết
4,798
Được thích
4,032
Điểm
860
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
 

xuannt2014

Thành viên mới
Tham gia ngày
3 Tháng mười 2018
Bài viết
4
Được thích
0
Điểm
13
Tuổi
34
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
 

giaiphap

Thành viên gạo cội
Tham gia ngày
12 Tháng ba 2007
Bài viết
4,798
Được thích
4,032
Điểm
860
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
 

xuannt2014

Thành viên mới
Tham gia ngày
3 Tháng mười 2018
Bài viết
4
Được thích
0
Điểm
13
Tuổi
34
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.
 

sunnyhuu

Thành viên mới
Tham gia ngày
24 Tháng bảy 2013
Bài viết
32
Được thích
2
Điểm
365
Tuổi
31
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

Lần chỉnh sửa cuối:

giaiphap

Thành viên gạo cội
Tham gia ngày
12 Tháng ba 2007
Bài viết
4,798
Được thích
4,032
Điểm
860
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.
 

giaiphap

Thành viên gạo cội
Tham gia ngày
12 Tháng ba 2007
Bài viết
4,798
Được thích
4,032
Điểm
860
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
 

sunnyhuu

Thành viên mới
Tham gia ngày
24 Tháng bảy 2013
Bài viết
32
Được thích
2
Điểm
365
Tuổi
31
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.
 

giaiphap

Thành viên gạo cội
Tham gia ngày
12 Tháng ba 2007
Bài viết
4,798
Được thích
4,032
Điểm
860
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
 

be09

TNMT_Đồng Nai
Tham gia ngày
9 Tháng tư 2011
Bài viết
8,255
Được thích
8,050
Điểm
560
Tuổi
62
Nơi ở
Biên Hòa, Đồng Nai
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ì đó?
 

sunnyhuu

Thành viên mới
Tham gia ngày
24 Tháng bảy 2013
Bài viết
32
Được thích
2
Điểm
365
Tuổi
31
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á đó.
 

be09

TNMT_Đồng Nai
Tham gia ngày
9 Tháng tư 2011
Bài viết
8,255
Được thích
8,050
Điểm
560
Tuổi
62
Nơi ở
Biên Hòa, Đồng Nai
À, 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

Lần chỉnh sửa cuối:

sunnyhuu

Thành viên mới
Tham gia ngày
24 Tháng bảy 2013
Bài viết
32
Được thích
2
Điểm
365
Tuổi
31
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:

sunnyhuu

Thành viên mới
Tham gia ngày
24 Tháng bảy 2013
Bài viết
32
Được thích
2
Điểm
365
Tuổi
31
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.
 

sunnyhuu

Thành viên mới
Tham gia ngày
24 Tháng bảy 2013
Bài viết
32
Được thích
2
Điểm
365
Tuổi
31
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
 
Top Bottom