Hỏi code tự xác định vùng dữ liệu nguồn.

[TrungChinhs]

Mình dùng Macro để copy dữ liệu từ một sheet nguồn sang một sheet đích trong cùng cùng 1 file nhưng do vùng dữ liệu trong file nguồn không giống nhau nên trước khi chạy macro phải điều chỉnh sao cho đầu bảng dữ liệu nguồn (góc trên trái) về đúng ô đã chỉ định trong Code và phải xác định vùng dữ liệu rộng nhất để khỏi sót dữ liệu. Vì vậy mình muốn nhờ các bạn viết giúp code để macro tự xác định vùng dữ liệu và dán đúng vào bảng đích (bảng đích là cố định và bảng nguồn có cấu trúc giống nhau). Xin cám ơn !

 

[Mr Okebab]

Mình dùng Macro để copy dữ liệu từ một sheet nguồn sang một sheet đích trong cùng cùng 1 file nhưng do vùng dữ liệu trong file nguồn không giống nhau nên trước khi chạy macro phải điều chỉnh sao cho đầu bảng dữ liệu nguồn (góc trên trái) về đúng ô đã chỉ định trong Code và phải xác định vùng dữ liệu rộng nhất để khỏi sót dữ liệu. Vì vậy mình muốn nhờ các bạn viết giúp code để macro tự xác định vùng dữ liệu và dán đúng vào bảng đích (bảng đích là cố định và bảng nguồn có cấu trúc giống nhau). Xin cám ơn !

Rất khó khăn để đề ra sự tổng quát cho vấn đề này, vì vậy bạn nên gửi file lên để mọi người hiểu rõ hơn.

Thân!

 

[TrungChinhs]

Xin cảm ơn Bác ! dưới dây là file đính kèm bài trên, trong các sheet nguon, nguon2, Bang mau có giải thích cụ thể và xem code macro trong sub copy

 

[ThuNghi]

Xin cảm ơn Bác ! dưới dây là file đính kèm bài trên, trong các sheet nguon, nguon2, Bang mau có giải thích cụ thể và xem code macro trong sub copy

Tại sao bạn tự làm khó mình, nguon thì dữ liệu bắt đầu là G4, nguon2 thì dữ liệu bắt đầu là C3, tuy cấu trúc bảng như nhau. Xin hỏi dòng đầu có phải là dòng mà có số là 1, và dòng cuối là cuối của cột "Nhân khẩu thống kê". Phải có 1 cái gì nhận dạnh dòng đầu và cuối, cột thì cố định rôi.

 

[ndu96081631]

Tôi đang test thử code thế này đây để xác định vùng dử liệu:

Sub Test()
 Dim Temp As Range, Rng As Range
 Set Temp = ActiveSheet.UsedRange.SpecialCells(2, 23)
 Set Rng = Temp(1, 1).CurrentRegion
 Rng.Select
End Sub

Nói chung tạm ổn, nhưng code này vẩn có thể sai nếu như xung quanh vùng dử liệu gốc bạn gõ dử liệu lung tung vào!
Ví dụ: Dử liệu thật sự nằm ở C5:K100, nhưng tại A1 bạn lại gõ linh tinh gì đó vào thì có trời mới xác định nổi!
Vì lẽ đó mà bạn phải bảo đãm rằng xung quanh vùng dử liệu gốc nhất định phải "sạch sẽ"... và thêm nữa: Vùng dử liệu của bạn không nên có dòng rổng (là nguyên cả 1 dòng không có dử liệu)... Chuyện còn lại không có vấn đề

 

[SA_DQ]

Xem thêm trong file đính kèm.

Macro sau sẽ chép DL (dữ liệu) từ 2 trang tính nguon đến 'Mau'

Option Explicit
Sub CopyToSheet()
 Dim Sh As Worksheet
 Dim sTieuDe As String
 Dim Rng As Range
 
 Sheets("Bang Mau").Select:                  sTieuDe = [g2]
 Range("f4:V" & [h65432].End(xlUp).Row + 9).Clear
 
 For Each Sh In Worksheets
   If Sh.Name <> "Bang mau" Then
      Set Rng = Sh.Cells.Find(what:=sTieuDe, LookIn:=xlValues)
      If Not Rng Is Nothing Then
         Set Rng = Rng.CurrentRegion
         Set Rng = Rng.Offset(1).Resize(Rng.Rows.Count - 1, Rng.Columns.Count)
         Rng.Copy Destination:=[f65432].End(xlUp).Offset(1)
   End If:           End If
 Next Sh
End Sub

 

[TrungChinhs]

Cảm ơn các Bác nhiều ! Em đã chạy thử, kết bước đầu là ổn rồi (không biết sau này có phát sinh gì không ?).

Lý do bảng nguồn nằm lung tung là do nhiều người làm, mỗi người một ý thích nên người làm tổng hợp mới có ý khổ.

Vấn đề dữ liệu "rác" nằm ngoài vùng dữ liệu mà Bác ndu96081631 nêu ở trên em cũng chưa nghĩ ra vì vậy em sẽ nhắc anh em lưu ý khi tổng hợp.

Chúc các Bác ngon giấc... và mơ thấy nhiều code hay !

 

[TrungChinhs]

Macro sau sẽ chép DL (dữ liệu) từ 2 trang tính nguon đến 'Mau'

Option Explicit
Sub CopyToSheet()
 Dim Sh As Worksheet
 Dim sTieuDe As String
 Dim Rng As Range
 
 Sheets("Bang Mau").Select:                  sTieuDe = [g2]
 Range("f4:V" & [h65432].End(xlUp).Row + 9).Clear
 
 For Each Sh In Worksheets
   If Sh.Name <> "Bang mau" Then
      Set Rng = Sh.Cells.Find(what:=sTieuDe, LookIn:=xlValues)
      If Not Rng Is Nothing Then
         Set Rng = Rng.CurrentRegion
         Set Rng = Rng.Offset(1).Resize(Rng.Rows.Count - 1, Rng.Columns.Count)
         Rng.Copy Destination:=[f65432].End(xlUp).Offset(1)
   End If:           End If
 Next Sh
End Sub

Nhờ các Bác sửa giúp lỗi trong code này, yêu cầu cụ thể trong file đính kèm. Xin cảm ơn