Copy dữ liệu từ sheet này sang sheet khác loại bỏ blank (1 người xem)

[trungletien]

Các bác cho em hỏi em muốn copy dữ liệu từ sheet 1 sang sheet 2 và loại bỏ các dòng trống giữa các dữ liệu. Tức là khi sang sheet 2 a,b,c,d,e sẽ ở các dòng liên tiếp chứ không cách nhau với khoảng trống như sheet 1.

Em muốn tìm hàm tự động chứ không dùng phương pháp thủ công (như filter...).

Em cảm ơn các bác ạ.

 

[Kiều Mạnh]

Các bác cho em hỏi em muốn copy dữ liệu từ sheet 1 sang sheet 2 và loại bỏ các dòng trống giữa các dữ liệu. Tức là khi sang sheet 2 a,b,c,d,e sẽ ở các dòng liên tiếp chứ không cách nhau với khoảng trống như sheet 1.

Em muốn tìm hàm tự động chứ không dùng phương pháp thủ công (như filter...).

Em cảm ơn các bác ạ.

Hàm thì mình không biết .... nếu xài code thì thử code đơn giản nhất sau nha

Sub CopyABC()
    On Error Resume Next
    Sheet1.UsedRange.Copy
    Sheet2.Range("A1").PasteSpecial (3)
    Sheet2.Range(Sheet2.[A1], Sheet2.[A10000].End(3)).SpecialCells(4).EntireRow.Delete
End Sub

 

[khongnhienttt]

Hàm thì mình không biết .... nếu xài code thì thử code đơn giản nhất sau nha

Sub CopyABC()
    On Error Resume Next
    Sheet1.UsedRange.Copy
    Sheet2.Range("A1").PasteSpecial (3)
    Sheet2.Range(Sheet2.[A1], Sheet2.[A10000].End(3)).SpecialCells(4).EntireRow.Delete
End Sub

bạn có thể cho mình xin link hướng dẫn về các số trong ngoặc đơn tương đương với gì không, sẵn đây cũng góp thêm

Sub xoadongtrong()
Sheet1.UsedRange.Copy Destination:=Sheet2.Range("a1")
Dim i As Long
        For i = Sheet2.UsedRange.Rows.Count To 1 Step -1
            If WorksheetFunction.CountA(Sheet2.UsedRange.Rows(i)) = 0 Then
                Sheet2.UsedRange.Rows(i).EntireRow.Delete
            End If
        Next i
End Sub

 

[Kiều Mạnh]

bạn có thể cho mình xin link hướng dẫn về các số trong ngoặc đơn tương đương với gì không, sẵn đây cũng góp thêm

Sub xoadongtrong()
Sheet1.UsedRange.Copy Destination:=Sheet2.Range("a1")
Dim i As Long
        For i = Sheet2.UsedRange.Rows.Count To 1 Step -1
            If WorksheetFunction.CountA(Sheet2.UsedRange.Rows(i)) = 0 Then
                Sheet2.UsedRange.Rows(i).EntireRow.Delete
            End If
        Next i
End Sub

quậy diết biết thôi mà......... trên GPE có nhiều Bạn chịu khó tìm nha.... mình ko nhớ lắm
viết đơn giản như mình đi ....có vậy For làm gì cho mệt.......

 

[Kiều Mạnh]

Nếu chủ thớt thích For Next thì thử code sau xem sao

Sub CopyABC2()
Dim Nguon(), Kq(), i, j, k
Nguon = Sheet1.Range("A1:C100000").Value
ReDim Kq(1 To UBound(Nguon, 1), 1 To UBound(Nguon, 2))
For i = 1 To UBound(Nguon, 1)
    If Nguon(i, 1) <> Empty Then
        k = k + 1
        For j = 1 To UBound(Nguon, 2)
            Kq(k, j) = Nguon(i, j)
        Next
    End If
Next
Sheet2.Range("A1").Resize(k, UBound(Nguon, 2)) = Kq
End Sub

 

[ndu96081631]

Hàm thì mình không biết .... nếu xài code thì thử code đơn giản nhất sau nha

Sub CopyABC()
    On Error Resume Next
    Sheet1.UsedRange.Copy
    Sheet2.Range("A1").PasteSpecial (3)
    Sheet2.Range(Sheet2.[A1], Sheet2.[A10000].End(3)).SpecialCells(4).EntireRow.Delete
End Sub

bạn có thể cho mình xin link hướng dẫn về các số trong ngoặc đơn tương đương với gì không, sẵn đây cũng góp thêm

Sub xoadongtrong()
Sheet1.UsedRange.Copy Destination:=Sheet2.Range("a1")
Dim i As Long
        For i = Sheet2.UsedRange.Rows.Count To 1 Step -1
            If WorksheetFunction.CountA(Sheet2.UsedRange.Rows(i)) = 0 Then
                Sheet2.UsedRange.Rows(i).EntireRow.Delete
            End If
        Next i
End Sub

Trong file của tác giả làm gì có cái Sheet1 nào mà các bạn cứ Sheet1.UsedRange.Copy nhỉ?
Mà cứ cho là có Sheet1 đi thì code của anh Mạnh sẽ gặp tình trạng này:
























dữ liệu ndu sẽ bị cho đi Syberia luôn

 

[Kiều Mạnh]

Trong file của tác giả làm gì có cái Sheet1 nào mà các bạn cứ Sheet1.UsedRange.Copy nhỉ?
Mà cứ cho là có Sheet1 đi thì code của anh Mạnh sẽ gặp tình trạng này:

View attachment 146272






















dữ liệu ndu sẽ bị cho đi Syberia luôn

Thì Em mê code két cứ viết đại đi khi nào họ la lên ta lại tính tiếp mà Anh..

 

[doveandrose]

ơ thế là có trục trặc kỹ thuật à ? để tôi la dùm cho
bớ người ta code chạy sai . hi hi

 

[be_09]

Tác giả hỏi xong thì chạy mất tiêu rồi.

 

[khongnhienttt]

haha vậy code của mình vẫn chạy đúng, hihi

 

[trungletien]

Hàm thì mình không biết .... nếu xài code thì thử code đơn giản nhất sau nha

Sub CopyABC()
    On Error Resume Next
    Sheet1.UsedRange.Copy
    Sheet2.Range("A1").PasteSpecial (3)
    Sheet2.Range(Sheet2.[A1], Sheet2.[A10000].End(3)).SpecialCells(4).EntireRow.Delete
End Sub

Em cảm ơn bác nhiều ạ!! Em dùng code của bác thì làm được rồi ạ

Bác cho em hỏi vấn đề tương tự như trong file đính kèm em gửi dưới đây. Bây giờ các dữ liệu bị ngăn cách bởi tiêu đề (Tên, Tuổi, Địa chỉ). Giờ em muốn xóa cả dòng trống và dòng tiêu đề để ra sheet 2 chỉ gồm toàn dữ liệu như bác đã giải quyết hộ em ở trên.

Ở dòng 7 và 13 có 2 dữ liệu x và y (giả định là người làm dữ liệu lỡ tay nhập vào, giờ em cũng muốn xóa luôn 2 dòng đó ạ!

Em cảm ơn bác nhiều ạ!

 

[trungletien]

Em dùng code của bác kieu manh thì xóa được dòng x và y rồi ạ.
Còn dòng tiêu đề "Tên, tuổi, điạ chỉ" em không biết cách xóa ạ
Các bác giúp em với ạ

 

[Quang_Hải]

Em dùng code của bác kieu manh thì xóa được dòng x và y rồi ạ.
Còn dòng tiêu đề "Tên, tuổi, điạ chỉ" em không biết cách xóa ạ
Các bác giúp em với ạ

Bài này thủ công còn nhanh hơn code nhiều. Dùng lệnh sort có sẵn, sau khi sort rồi thì coi ông nào dư thừa thì tiễn đi tây phương.

 

[trungletien]

Bài này thủ công còn nhanh hơn code nhiều. Dùng lệnh sort có sẵn, sau khi sort rồi thì coi ông nào dư thừa thì tiễn đi tây phương.

Bác thông cảm sếp em yêu cầu phải tự động hóa, chỉ cần nhập dữ liệu gốc là ra kết quả ạ (

 

[Quang_Hải]

Bác thông cảm sếp em yêu cầu phải tự động hóa, chỉ cần nhập dữ liệu gốc là ra kết quả ạ (

Dữ liệu quá sơ sài thì code khó mà đúng ý

Sub Abc()
Dim Arr(), i As Long, k As Long, Res()
Arr = Range("A3", [C65536].End(3)).Value
ReDim Res(1 To UBound(Arr), 1 To 3)
For i = 1 To UBound(Arr)
   If Arr(i, 1) <> "" Then
      If Replace(UCase(Arr(i, 1)), " ", "") <> "TÊN" Then
         k = k + 1
         Res(k, 1) = Arr(i, 1)
         Res(k, 2) = Arr(i, 2)
         Res(k, 3) = Arr(i, 3)
      End If
   End If
Next
[E3].Resize(k, 3) = Res
End Sub

 

[trungletien]

Dữ liệu quá sơ sài thì code khó mà đúng ý

Sub Abc()
Dim Arr(), i As Long, k As Long, Res()
Arr = Range("A3", [C65536].End(3)).Value
ReDim Res(1 To UBound(Arr), 1 To 3)
For i = 1 To UBound(Arr)
   If Arr(i, 1) <> "" Then
      If Replace(UCase(Arr(i, 1)), " ", "") <> "TÊN" Then
         k = k + 1
         Res(k, 1) = Arr(i, 1)
         Res(k, 2) = Arr(i, 2)
         Res(k, 3) = Arr(i, 3)
      End If
   End If
Next
[E3].Resize(k, 3) = Res
End Sub

Em cảm ơn bác. Code bác cho hiệu quả thật . Nhưng em muốn kết quả để ở sheet 2 thì làm thế nào ạ

Bác thông cảm em không biết gì về VBA ạ

 

[Quang_Hải]

Em cảm ơn bác. Code bác cho hiệu quả thật . Nhưng em muốn kết quả để ở sheet 2 thì làm thế nào ạ

Bác thông cảm em không biết gì về VBA ạ

Bạn phải cố gắng suy nghĩ và tự mày mò thay thế. Có như thế mới mau khá lên được. 3 năm trước mình cũng như bạn thôi. Toàn lấy code trên diễn đàn về và tự suy gẫm, thay hết chỗ này đến chỗ khác. Khi code chạy thì thấy sướng lắm lắm.
Ví dụ: Sheets("ABC").[E3].Resize(k, 3) = Res
Với ABC là tên sheet đích đến