Nhờ mọi người sửa giúp VBA copy và xuất file

[Minhkhoi1206]

Do bị nhắc nhở là bài đăng sai chủ đề nêm xin phép admin đăng lại để nhờ mọi người trợ giúp.
Mình mới tự học nên lọ mọ viết cái hàm copy dữ liệu các sheet nhưng hiện tại còn vướng mắc vấn đề sau nhờ mọi người giúp đỡ ạ:
1. Dữ liệu sheet gốc có chứa lệnh nên khi copy sang các sheet để xuất ra nó bị mất số 0 ở đầu các cột định dạng giá trị là số
2. Hàm xuất ra mới chỉ làm được đến đặt tên file và chỉ xuất được 1 sheet và chưa lưu ra ngoài màn hình đươc

Sub Copy_Sheet()
Sheet1.Activate 'Chon Sheet tra ket qua
Sheet2.Activate 'Chon Sheet tra ket qua
Sheet3.Activate 'Chon Sheet tra ket qua
Sheet4.Activate 'Chon Sheet tra ket qua
Sheet5.Select 'Chon Sheet xu ly

'Dinh dang co chu
Sheet2.Range("A2:AT1000").Font.Size = 10
Sheet3.Range("A2:W1000").Font.Size = 10
Sheet5.Range("A3:AO1000").Font.Size = 10
'Tu dong lam vua o chua
Sheet2.Range("A1:AT1").EntireRow.RowHeight = 30
Sheet3.Range("A1:W1").EntireRow.RowHeight = 30
Sheet5.Range("A2:AO2").EntireRow.RowHeight = 30
Sheet2.Range("A2:A1000").EntireColumn.AutoFit
Sheet2.Range("A2:A1000").EntireRow.AutoFit
Sheet3.Range("A2:A1000").EntireColumn.AutoFit
Sheet3.Range("A2:A1000").EntireRow.AutoFit
Sheet5.Range("A2:A1000").EntireColumn.AutoFit
Sheet5.Range("A2:A1000").EntireRow.AutoFit
Sheet4.Range("A2:C2").EntireColumn.AutoFit
Sheet4.Range("A2:C2").EntireRow.AutoFit

'Dinh dang ngay thang
Sheet2.Range("D21000").NumberFormat = "dd/mm/yyyy"
Sheet2.Range("AA2:AA1000").NumberFormat = "dd/mm/yyyy"
Sheet2.Range("AC2:AD1000").NumberFormat = "mm/yyyy"
Sheet2.Range("AR2:AR1000").NumberFormat = "dd/mm/yyyy"
Sheet3.Range("N2:N1000").NumberFormat = "dd/mm/yyyy"

'Copy du lieu Sheet Import
Sheet2.Range("A2:A1000").Value = Sheet5.Range("AB3:AB1001").Value
Sheet2.Range("C21000").Value = Sheet5.Range("AC3:AD1001").Value
Sheet2.Range("E2:F1000").Value = Sheet5.Range("J3:K1001").Value
Sheet2.Range("H2:J1000").Value = Sheet5.Range("L3:N1001").Value
Sheet2.Range("K2:K1000").Value = Sheet5.Range("P31001").Value
Sheet2.Range("R2:T1000").Value = Sheet5.Range("AE3:AG1001").Value
Sheet2.Range("AA2:AA1000").Value = Sheet5.Range("AH3:AH1001").Value
Sheet2.Range("AB2:AB1000").Value = Sheet5.Range("U3:U1001").Value
Sheet2.Range("AC2:AC1000").Value = Sheet5.Range("AI3:AI1001").Value
Sheet2.Range("AE2:AE1000").Value = Sheet5.Range("AJ3:AJ1001").Value
Sheet2.Range("AJ2:AJ1000").Value = Sheet5.Range("AK3:AK1001").Value
Sheet2.Range("AL2:AM1000").Value = Sheet5.Range("AL3:AM1001").Value
Sheet2.Range("AN2:AN1000").Value = Sheet5.Range("R3:R1001").Value
Sheet2.Range("AR2:AS1000").Value = Sheet5.Range("AN3:AO1001").Value

'Copy du lieu Sheet HGD
Sheet3.Range("B2:C1000").Value = Sheet5.Range("A3:B1001").Value
Sheet3.Range("D21000").Value = Sheet5.Range("D31001").Value
Sheet3.Range("E2:F1000").Value = Sheet5.Range("E3:F1001").Value
Sheet3.Range("G2:I1000").Value = Sheet5.Range("AE3:AG1001").Value
Sheet3.Range("K2:L1000").Value = Sheet5.Range("G3:H1001").Value
Sheet3.Range("N21000").Value = Sheet5.Range("I3:K1001").Value
Sheet3.Range("Q2:S1000").Value = Sheet5.Range("L3:N1001").Value
Sheet3.Range("T2:U1000").Value = Sheet5.Range("O31001").Value
Sheet3.Range("W2:W1000").Value = Sheet5.Range("C3:C1001").Value

'Copy du lieu Sheet Ghi chu
Sheet4.Range("A2:A2").Value = Sheet5.Range("AB1:AD1").Value
Sheet4.Range("B2:B2").Value = Sheet5.Range("AE1:AH1").Value
Sheet4.Range("C2:C2").Value = Sheet5.Range("AI1:AO1").Value

'Export_File
Dim Path As String, NameFile As String
NameFile = Sheet5.Range("AB1")
Sheets(Sheet2.Name).Copy
ActiveWorkbook.Close True, Path & NameFile & ".xlsx"


Application.CutCopyMode = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
End Sub

 

[Maika8008]

Vấn đề 1: Dữ liệu sheet gốc có chứa lệnh nên khi copy sang các sheet để xuất ra nó bị mất số 0 ở đầu các cột định dạng giá trị là số:
Bạn phải định dạng các cột bị mất số 0 ở đầu đó ở dạng Text. Lý do: tại vùng dữ liệu nguồn được định dạng là Text, nên các chuỗi đó mới giữ được số 0 ở đầu chứ!
Vấn đề 2: Thay đoạn code này:
'Export_File
Dim Path As String, NameFile As String
NameFile = Sheet5.Range("AB1")
Sheets(Sheet2.Name).Copy
ActiveWorkbook.Close True, Path & NameFile & ".xlsx"

Bằng đoạn:
'Export_File
Dim Path As String, NameFile As String
NameFile = Sheet5.Range("AB1")
Path = Environ("HOMEDRIVE") & Environ("HOMEPATH") & "\Desktop\"
Sheets(Array(Sheet1.Name, Sheet2.Name, Sheet3.Name, Sheet4.Name, Sheet5.Name)).Copy
ActiveWorkbook.Close True, Path & NameFile & ".xlsx"

Chỗ Sheets(Array(Sheet1.Name, Sheet2.Name, Sheet3.Name, Sheet4.Name, Sheet5.Name)).Copy bạn không muốn copy sheet nào thì xóa tên nó đi.

Còn các dòng lệnh bên trên đó có nhiều chỗ linh tinh lắm nhưng tôi không bàn đến, chạy được là được

 

[Minhkhoi1206]

Vấn đề 1: Dữ liệu sheet gốc có chứa lệnh nên khi copy sang các sheet để xuất ra nó bị mất số 0 ở đầu các cột định dạng giá trị là số:
Bạn phải định dạng các cột bị mất số 0 ở đầu đó ở dạng Text. Lý do: tại vùng dữ liệu nguồn được định dạng là Text, nên các chuỗi đó mới giữ được số 0 ở đầu chứ!
Vấn đề 2: Thay đoạn code này:
'Export_File
Dim Path As String, NameFile As String
NameFile = Sheet5.Range("AB1")
Sheets(Sheet2.Name).Copy
ActiveWorkbook.Close True, Path & NameFile & ".xlsx"

Bằng đoạn:
'Export_File
Dim Path As String, NameFile As String
NameFile = Sheet5.Range("AB1")
Path = Environ("HOMEDRIVE") & Environ("HOMEPATH") & "\Desktop\"
Sheets(Array(Sheet1.Name, Sheet2.Name, Sheet3.Name, Sheet4.Name, Sheet5.Name)).Copy
ActiveWorkbook.Close True, Path & NameFile & ".xlsx"

Chỗ Sheets(Array(Sheet1.Name, Sheet2.Name, Sheet3.Name, Sheet4.Name, Sheet5.Name)).Copy bạn không muốn copy sheet nào thì xóa tên nó đi.

Còn các dòng lệnh bên trên đó có nhiều chỗ linh tinh lắm nhưng tôi không bàn đến, chạy được là được

Cảm ơn bạn rất rất nhiều!!! đã sửa theo cách của bạn chạy được luôn định dạng lại cột chứa dữ liệu sang dạng text vậy mà mấy hôm cứ mò xem có cách nào để cho nó định dạng luôn vào trong hàm

 

[Maika8008]

Cảm ơn bạn rất rất nhiều!!! đã sửa theo cách của bạn chạy được luôn định dạng lại cột chứa dữ liệu sang dạng text vậy mà mấy hôm cứ mò xem có cách nào để cho nó định dạng luôn vào trong hàm

Tôi giữ nguyên code của bạn nhằm cho bạn biết lý do chứ nếu bạn làm theo cách này thì sẽ chép nguyên định dạng nguồn nè. Tôi lấy ví dụ 1 dòng:
Sheet2.Range("A2:A1000").Value = Sheet5.Range("AB3:AB1001").Value

thay bằng: Sheet5.Range("AB3:AB1001").Copy Sheet2.Range("A2")

Như vậy bạn không cần định dạng trước cột đích.

Update: Hoặc nếu chỉ muốn định dạng Text bằng lệnh chứ không chép nguyên định dạng bên dữ liệu nguồn sang thì bạn thêm lệnh này trước khi chép dữ liệu:
Sheet2.Range("A2:A1000").NumberFormat = "@"
Sheet2.Range("K2:K1000").NumberFormat = "@"
Theo tôi thấy chỉ 2 cột đó là cần phải làm vậy

 

[Minhkhoi1206]

Tôi giữ nguyên code của bạn nhằm cho bạn biết lý do chứ nếu bạn làm theo cách này thì sẽ chép nguyên định dạng nguồn nè. Tôi lấy ví dụ 1 dòng:
Sheet2.Range("A2:A1000").Value = Sheet5.Range("AB3:AB1001").Value

thay bằng: Sheet5.Range("AB3:AB1001").Copy Sheet2.Range("A2")

Như vậy bạn không cần định dạng trước cột đích.

Thank bạn nhiều mình đã hiểu rồi. Tiện bạn có thể chỉ giúp mình cách nào nếu dữ liệu 1 ô chỉ định trong sheet xử lý dữ liệu mà trống thì không copy dòng tương ứng sang 2 sheet kia được không bạn?

 

[Maika8008]

Thank bạn nhiều mình đã hiểu rồi. Tiện bạn có thể chỉ giúp mình cách nào nếu dữ liệu 1 ô chỉ định trong sheet xử lý dữ liệu mà trống thì không copy dòng tương ứng sang 2 sheet kia được không bạn?

Tất nhiên là được nhưng bạn có thể chỉ ra cụ thể được không?

 

[Minhkhoi1206]

Tất nhiên là được nhưng bạn có thể chỉ ra cụ thể được không?

Ví dụ ô AJ3 = trắng thì không copy dữ liệu của hàng thứ 3 sang sh2 sheet Import và Phu_Luc_TK1

 

[Maika8008]

Ví dụ ô AJ3 = trắng thì không copy dữ liệu của hàng thứ 3 sang sh2 sheet Import và Phu_Luc_TK1

Tôi thấy cột AJ (của sheet5 - bạn không nói AJ của sheet nào) có tiêu đề là Tỷ lệ. Bạn có chắc muốn lấy cột đó làm điều kiện không? Tôi nghĩ là cột C mới đúng logic chứ?

 

[Minhkhoi1206]

Tôi thấy cột AJ (của sheet5 - bạn không nói AJ của sheet nào) có tiêu đề là Tỷ lệ. Bạn có chắc muốn lấy cột đó làm điều kiện không? Tôi nghĩ là cột C mới đúng logic chứ?

Đúng rồi bạn chính là cái sheet 5 cột AJ mục tỉ lệ vì nếu chọn cột C sẽ ko đúng được vì có người có mã hộ có người không chỉ có cái Tỉ lệ nếu tham gia thì mới có được

 

[Maika8008]

Đúng rồi bạn chính là cái sheet 5 cột AJ mục tỉ lệ vì nếu chọn cột C sẽ ko đúng được vì có người có mã hộ có người không chỉ có cái Tỉ lệ nếu tham gia thì mới có được

Bạn thử xem thế nào. Muốn chỉnh sửa gì thì báo lại.

Còn muốn viết cho nó ra ngô ra khoai thì phải sửa toàn bộ code gốc.

 

[Minhkhoi1206]

Bạn thử xem thế nào. Muốn chỉnh sửa gì thì báo lại.

Còn muốn viết cho nó ra ngô ra khoai thì phải sửa toàn bộ code gốc.

Cảm ơn bạn nhé để mình làm nếu có gì mình hỏi nhờ mọi người

 

[Minhkhoi1206]

Bạn thử xem thế nào. Muốn chỉnh sửa gì thì báo lại.

Còn muốn viết cho nó ra ngô ra khoai thì phải sửa toàn bộ code gốc.

Mình đã sửa và thêm 1 số cái nhưng có cái hàm không xuất dữ liệu dòng có ô trống mình sửa lại à của cột U thì nó không chạy nhờ bạn kiểm tra giúp m với. Cảm ơn bạn!!!

 

[Maika8008]

Mình đã sửa và thêm 1 số cái nhưng có cái hàm không xuất dữ liệu dòng có ô trống mình sửa lại à của cột U thì nó không chạy nhờ bạn kiểm tra giúp m với. Cảm ơn bạn!!!

Bạn trình bày mạch lạc câu kéo giúp tôi. Viết 3, 4 ý trong 1 câu không có đầu đuôi phết phẩy gì cả, tôi không hiểu được!!!

 

[Minhkhoi1206]

Bạn trình bày mạch lạc câu kéo giúp tôi. Viết 3, 4 ý trong 1 câu không có đầu đuôi phết phẩy gì cả, tôi không hiểu được!!!

Vâng xin lỗi bạn!
Ý mình là sau khi mình đã sửa lại cái hàm ban đầu bạn giúp mình thành: Khi chạy VBA thì Sheet 2 (tên Import) chỉ lấy dữ liệu các dòng mà cột U ở sheet 5 có dữ liệu, nếu không có thì không lấy dữ liệu sang. Nhưng sau khi sửa thì chạy VBA nó trắng luôn ko nhặt dữ liệu sang nữa.

Dim Rg As Range
Dim i As Long
For i = 2 To Sheet2.Range("C65536").End(xlUp).Row
If Sheets(Sheet2.Name).Range("U" & i) = "" Then
If Rg Is Nothing Then
Set Rg = Sheets(Sheet2.Name).Range("U" & i)
Else
Set Rg = Union(Rg, Sheets(Sheet2.Name).Range("U" & i))
End If
End If
Next
Rg.EntireRow.Delete

 

[Maika8008]

Vâng xin lỗi bạn!
Ý mình là sau khi mình đã sửa lại cái hàm ban đầu bạn giúp mình thành: Khi chạy VBA thì Sheet 2 (tên Import) chỉ lấy dữ liệu các dòng mà cột U ở sheet 5 có dữ liệu, nếu không có thì không lấy dữ liệu sang. Nhưng sau khi sửa thì chạy VBA nó trắng luôn ko nhặt dữ liệu sang nữa.

Dim Rg As Range
Dim i As Long
For i = 2 To Sheet2.Range("C65536").End(xlUp).Row
If Sheets(Sheet2.Name).Range("U" & i) = "" Then
If Rg Is Nothing Then
Set Rg = Sheets(Sheet2.Name).Range("U" & i)
Else
Set Rg = Union(Rg, Sheets(Sheet2.Name).Range("U" & i))
End If
End If
Next
Rg.EntireRow.Delete

Bạn xem: cột U của bạn (DIACHIHK) có dữ liệu gì đâu mà bảo nó đừng xóa?

 

[Minhkhoi1206]

Bạn xem: cột U của bạn (DIACHIHK) có dữ liệu gì đâu mà bảo nó đừng xóa?
View attachment 258526

À mình bị ngáo rồi cứ dựa theo cái sheet 5 để làm. Cảm ơn bạn đã nhắc

 

[Minhkhoi1206]

À mình bị ngáo rồi cứ dựa theo cái sheet 5 để làm. Cảm ơn bạn đã nhắc

Nhờ bạn và mọi người trợ giúp gấp thêm file này nữa với mình sửa code để áp dụng cho việc xử lý dữ liệu gửi đơn vị để rà soát nhận hỗ trọe. Có 2 sheet mình muốn lấy số liệu đã copy số liệu từ sheet2 xử lý số liệu sang rồi nhưng mới chỉ xóa được các dóng ở sheet 4 với điều kiện từ K13 trở đi là trắng; còn ở sheet 3 với điều kiện từ K13 trở đi có dữ liệu thì xóa bỏ và xuất ra Destop.

 

[BuiQuangThuan]

Nhờ bạn và mọi người trợ giúp gấp thêm file này nữa với mình sửa code để áp dụng cho việc xử lý dữ liệu gửi đơn vị để rà soát nhận hỗ trọe. Có 2 sheet mình muốn lấy số liệu đã copy số liệu từ sheet2 xử lý số liệu sang rồi nhưng mới chỉ xóa được các dóng ở sheet 4 với điều kiện từ K13 trở đi là trắng; còn ở sheet 3 với điều kiện từ K13 trở đi có dữ liệu thì xóa bỏ và xuất ra Destop.

Bạn gấp thì nên giải thích rõ ràng 1 chút. Đừng nói để 1 mình bạn hiểu.
Muốn giúp nhưng đọc đi đọc lại mà chưa hiểu bạn muốn gì

 

[Minhkhoi1206]

Bạn gấp thì nên giải thích rõ ràng 1 chút. Đừng nói để 1 mình bạn hiểu.
Muốn giúp nhưng đọc đi đọc lại mà chưa hiểu bạn muốn gì

Mình muốn xóa các dòng có dữ liệu Ghi chú ở cột K từ K13 trở đi ở Sheet3
Sau đó xuất ra Destop file exel có tên file giống tên ô K6 ở Sheet2 và trong đó chưa 2 Sheet3 và Sheet4

 

[BuiQuangThuan]

Mình muốn xóa các dòng có dữ liệu Ghi chú ở cột K từ K13 trở đi ở Sheet3
Sau đó xuất ra Destop file exel có tên file giống tên ô K6 ở Sheet2 và trong đó chưa 2 Sheet3 và Sheet4

Trong file của bạn có code rồi. nó chưa đáp ứng được nhu cầu của bạn à
Tại thấy bạn cứ nói sheet3 và sheet4. nó là sheetcodename hay là số thứ tự sheet từ trái qua phải vậy