cắt dữ liệu từ sheet nay sang sheet khác

[Gà excel 123]

Dạ e chào anh chị, e có truong hợp này. Có 1 file Data nhan vien, khi nhan vien nghĩ thì e muốn tích chọn vào nhan vien đó (hoặc chuyen trạng thái off) . khi bấm nút cập nhật thì tự động cắt dòng nhan vien off sang Sheet nghĩ viec. giup e với. e nạp card ủng hộ ạ. đa tạ đa tạ.

 

[SA_DQ]

Dạ e chào anh chị, e có truong hợp này. Có 1 file Data nhan vien, khi nhan vien nghĩ thì e muốn tích chọn vào nhan vien đó (hoặc chuyen trạng thái off) . khi bấm nút cập nhật thì tự động cắt dòng nhan vien off sang Sheet nghĩ viec. giup e với. e nạp card ủng hộ ạ. đa tạ đa tạ.

Tích chọn hay nút chuyển trang thái đều có nguy cơ lớn;
(Mỗi nhân viên (NV) ntrong đơn vị đều có mã NV)
Vậy ít nguy cơ sẽ là: Nhập mã NV đó & bấm nút xác nhận chuyển
Ví dụ:

STT

Mã NV

Họ & Tên

NS

CV

VH

BT

..

..

1

BXT00

Bùi Xuân Thắm

2

BXT01

Bùi Thị Xuân Thành

3

CCH00

Châu Chấn Huy

4

CJL00

Cù Lân

5

CMN00

Công Tằng Tôn Nữ Minh Nguyệt

6

CNM00

Công Tằng Tôn Nữ Nguyệt Minh

7

CNS00

Chu Ngọc Sơn

8

CVA00

Cỗ Văn Ẩn

9

DAH00

Dương Ánh Hòa

10

FFD00

Đào Đức Dương

11

FFD01

Đỗ Đăng Dung

12

FLT00

Đinh La Thăng

13

LCM00

Lê Công Minh

14

LCM01

Lã Chí Mai

15

LCT00

Lê Công Thành

16

NHB00

Nguyễn Hòa Bình

17

NHB01

Ngô Thị Hòa Biền

18

NHB02

Nhữ Thái Hải Hà

19

THH00

Trần Minh Hồng Hà

20​

TJD00

Trần Dương

21​

TMH00

Trần Minh Hồng

22​

TMH01

Từ Mạnh Hóa

23​

TMH02

Trần Minh Hà

24​

TMH03

Tạ Thị Minh Hà

25​

TMH04

Trần Thị Minh Hà

26​

TTT00

Từ Thanh Tuấn

27​

TTT01

Trần Thành Trai

 

[anhtuan2939]

Dạ e chào anh chị, e có truong hợp này. Có 1 file Data nhan vien, khi nhan vien nghĩ thì e muốn tích chọn vào nhan vien đó (hoặc chuyen trạng thái off) . khi bấm nút cập nhật thì tự động cắt dòng nhan vien off sang Sheet nghĩ viec. giup e với. e nạp card ủng hộ ạ. đa tạ đa tạ.

Bạn gửi file của bạn với dữ liệu giả lập lên xem thế nào.

 

[Gà excel 123]

Bạn gửi file của bạn với dữ liệu giả lập lên xem thế nào.

Bạn gửi file của bạn với dữ liệu giả lập lên xem thế nào.

Bạn gửi file của bạn với dữ liệu giả lập lên xem thế nào.

Dạ e gửi anh nhé, hỗ trợ hỗ trợ...đa tạ sư huynh

 

[anhtuan2939]

Dạ e gửi anh nhé, hỗ trợ hỗ trợ...đa tạ sư huynh

Ở sheet1 ô P12 bạn thêm dữ liệu như này nhé, rồi chạy code phía dưới.
(Ở trạng thái thì theo mình dùng từ Nghỉ sẽ đúng hơn nhé)

Sub Loc()
    Dim lr As Integer
    
    lr = Sheet1.Range("B" & Rows.Count).End(xlUp).Row
    Sheet1.Range("A2:J" & lr).AdvancedFilter xlFilterCopy, Sheet1.Range("P1:P2"), Sheet2.Range("A2:J2"), False
End Sub

 

[Gà excel 123]

Ở sheet1 ô P12 bạn thêm dữ liệu như này nhé, rồi chạy code phía dưới.
(Ở trạng thái thì theo mình dùng từ Nghỉ sẽ đúng hơn nhé)
View attachment 281273

Sub Loc()
    Dim lr As Integer
   
    lr = Sheet1.Range("B" & Rows.Count).End(xlUp).Row
    Sheet1.Range("A2:J" & lr).AdvancedFilter xlFilterCopy, Sheet1.Range("P1:P2"), Sheet2.Range("A2:J2"), False
End Sub

Đúng là chuyển qua sheet khác nhưng là copy rồi. Em muốn khi chuyển qua sẽ xóa dữ liệu sheet 1 luôn ák sếp. hì hì

 

[anhtuan2939]

Giữ nguyên dữ liệu ở ô P1: P2

Sub Chuyen_du_lieu()
    Dim lr As Integer, i As Integer, j As Integer, R1 As Integer, R2 As Integer, Col As Integer
    Dim sArr(), dArr(), eArr()
    Dim Nghi As String
    
    Application.ScreenUpdating = False
    
    With Sheet1
        Nghi = .Range("P2").Value
        If .AutoFilterMode = True Then .AutoFilterMode = False
        lr = .Range("B" & Rows.Count).End(xlUp).Row
        sArr = .Range("A3:J" & lr).Value2
        Col = UBound(sArr, 2)
        ReDim dArr(1 To UBound(sArr, 1), 1 To Col)
        ReDim eArr(1 To UBound(sArr, 1), 1 To Col)
        For i = 1 To UBound(sArr, 1)
            If sArr(i, 10) <> Nghi Then
                R1 = R1 + 1
                For j = 1 To Col
                    dArr(R1, j) = sArr(i, j)
                Next j
            Else
                R2 = R2 + 1
                For j = 1 To Col
                    eArr(R2, j) = sArr(i, j)
                Next j
            End If
        Next i
        .Range("A3:J" & lr).ClearContents
        .Range("A3").Resize(R1, Col).Value = dArr
    End With
    
    With Sheet2
        If .AutoFilterMode = True Then .AutoFilterMode = False
        lr = .Range("B" & Rows.Count).End(xlUp).Row + 1
        If R2 > 0 Then .Range("A" & lr).Resize(R2, Col).Value = eArr
    End With
    Application.ScreenUpdating = True
End Sub

 

[Gà excel 123]

Giữ nguyên dữ liệu ở ô P1: P2

Sub Chuyen_du_lieu()
    Dim lr As Integer, i As Integer, j As Integer, R1 As Integer, R2 As Integer, Col As Integer
    Dim sArr(), dArr(), eArr()
    Dim Nghi As String
   
    Application.ScreenUpdating = False
   
    With Sheet1
        Nghi = .Range("P2").Value
        If .AutoFilterMode = True Then .AutoFilterMode = False
        lr = .Range("B" & Rows.Count).End(xlUp).Row
        sArr = .Range("A3:J" & lr).Value2
        Col = UBound(sArr, 2)
        ReDim dArr(1 To UBound(sArr, 1), 1 To Col)
        ReDim eArr(1 To UBound(sArr, 1), 1 To Col)
        For i = 1 To UBound(sArr, 1)
            If sArr(i, 10) <> Nghi Then
                R1 = R1 + 1
                For j = 1 To Col
                    dArr(R1, j) = sArr(i, j)
                Next j
            Else
                R2 = R2 + 1
                For j = 1 To Col
                    eArr(R2, j) = sArr(i, j)
                Next j
            End If
        Next i
        .Range("A3:J" & lr).ClearContents
        .Range("A3").Resize(R1, Col).Value = dArr
    End With
   
    With Sheet2
        If .AutoFilterMode = True Then .AutoFilterMode = False
        lr = .Range("B" & Rows.Count).End(xlUp).Row + 1
        If R2 > 0 Then .Range("A" & lr).Resize(R2, Col).Value = eArr
    End With
    Application.ScreenUpdating = True
End Sub

Dạ được rồi sếp ơi, gửi mail e xin số đt nhé.

 

[anhtuan2939]

giup e với. e nạp card ủng hộ ạ

Theo như nguyện vọng của bạn thì chỉ cần bạn ủng hộ diễn đàn là được, tài khoản nhận donation như bài 1 của link dưới nhé

https://www.giaiphapexcel.com/diendan/threads/donate-cho-diễn-đàn-giải-pháp-excel.155576/