Cách lấy dữ liệu vào 1 sheet trong excel (2 người xem)

[dat8x]

ai có thể giúp mình code VBA để lấy dữ liệu từ các sheet vào sheet tonghop theo các cột mà mình để sẵn trong sheet tonghop

 

[CHAOQUAY]

ai có thể giúp mình code VBA để lấy dữ liệu từ các sheet vào sheet tonghop theo các cột mà mình để sẵn trong sheet tonghop

Chạy thử

Sub TongHop()
Dim Ws As Worksheet
Dim Mang
Dim Kq
Dim i, j, k, x
k = Application.Worksheets.Count * 100
ReDim Kq(1 To k, 1 To 6)
k = 0
For Each Ws In Worksheets
    If Ws.Name <> "Tonghop" Then
        For i = 22 To Ws.UsedRange.Rows.Count
            If Ws.Range("B" & i) = "" Or Ws.Range("C" & i) = "" Then Exit For
            k = k + 1
            Kq(k, 1) = Ws.Name
            Kq(k, 2) = Ws.Range("B" & i)
            Kq(k, 3) = Ws.Range("G" & i)
            Kq(k, 4) = IIf(Ws.Range("H" & i) = "", Ws.Range("I" & i), Ws.Range("H" & i))
            Kq(k, 5) = Ws.Range("J" & i)
            Mang = Split(Left(Ws.Range("B15"), Len(Ws.Range("B15")) - 1))
            For j = 0 To UBound(Mang)
                If IsNumeric(Mang(j)) = False Then Mang(j) = ""
            Next j
            Kq(k, 6) = Replace(Application.Trim(Join(Mang)), " ", "/")
        Next i
    End If
Next Ws
With Sheets("Tonghop")
    .Range("A2:F10000").ClearContents
    .Range("A2").Resize(k, 6) = Kq
    .UsedRange.Columns.AutoFit
End With
End Sub

 

[tonnydung]

Em đang muốn Coppy (Coppy dữ liệu từ FileC Sheet "ktkle" Sang File A Sheet "NhapLich" Nếu FileC Nếu Cột BA và BG không có Dấu 'x"

- Dieu kien 1: cột B trong Sheet "ktkle" FileC và cột L Sheet "NhapLich " FileA (sheet và file hiện thời làm việc) có Code trùng nhau.
- Dieu kien 2: cột BA trong Sheet "NhapLich "FileA không có dấu "x" Thì coppy các cột D,E,F ở File C sang cột AX,AY,AZ ở fileA
- Dieu ien 3: FileC có thể đang đóng hoặc mở
Và tương tự nếu cột BG trong Sheet "NhapLich" FileA không có dấu "x" Thì coppy các cột I,J,K ở File C sang cột BD,BE,BF Sheet "NhapLich" fileA

Nhờ các bác giúp. Tks

 

[SA_DQ]

Cách mà bạn tạo ra 365 hay 366 trang tính trong 1 năm có thể sẽ phải xem lại

 

[VetMini]

Em đang muốn Coppy (Coppy dữ liệu từ FileC Sheet "ktkle" Sang File A Sheet "NhapLich" Nếu FileC Nếu Cột BA và BG không có Dấu 'x"

- Dieu kien 1: cột B trong Sheet "ktkle" FileC và cột L Sheet "NhapLich " FileA (sheet và file hiện thời làm việc) có Code trùng nhau.
- Dieu kien 2: cột BA trong Sheet "NhapLich "FileA không có dấu "x" Thì coppy các cột D,E,F ở File C sang cột AX,AY,AZ ở fileA
- Dieu ien 3: FileC có thể đang đóng hoặc mở
Và tương tự nếu cột BG trong Sheet "NhapLich" FileA không có dấu "x" Thì coppy các cột I,J,K ở File C sang cột BD,BE,BF Sheet "NhapLich" fileA

Nhờ các bác giúp. Tks

Bài giải ở đây nè

Nhờ sửa lỗi code VBA của hàm Vlookup

Em đang muốn Coppy (Coppy dữ liệu từ FileC Sheet "ktkle" Sang File A Sheet "NhapLich" Nếu FileC Nếu Cột BA và BG không có Dấu 'x" - Dieu kien 1: cột B trong Sheet "ktkle" FileC và cột L Sheet "NhapLich " FileA (sheet và file hiện thời làm việc) có Code trùng nhau. - Dieu kien 2: cột BA trong...

www.giaiphapexcel.com

 

[be_09]

Em đang muốn Coppy (Coppy dữ liệu từ FileC Sheet "ktkle" Sang File A Sheet "NhapLich" Nếu FileC Nếu Cột BA và BG không có Dấu 'x"

- Dieu kien 1: cột B trong Sheet "ktkle" FileC và cột L Sheet "NhapLich " FileA (sheet và file hiện thời làm việc) có Code trùng nhau.
- Dieu kien 2: cột BA trong Sheet "NhapLich "FileA không có dấu "x" Thì coppy các cột D,E,F ở File C sang cột AX,AY,AZ ở fileA
- Dieu ien 3: FileC có thể đang đóng hoặc mở
Và tương tự nếu cột BG trong Sheet "NhapLich" FileA không có dấu "x" Thì coppy các cột I,J,K ở File C sang cột BD,BE,BF Sheet "NhapLich" fileA

Nhờ các bác giúp. Tks

1/ Bạn không nên chen ngang bài viết của người khác khi không có cùng chủ đề "bạn hỏi về vấn đề gộp File", trong khi đó của chủ Topic là "gộp sheet".

2/ Bạn không nên viết một câu hỏi nhiều lần hay gửi cùng một câu hỏi trong nhiều box khác nhau, có thể sẽ vi phạm nội quy. Bài viết của bạn ở Link này Nhờ xử lý lỗi code VBA của hàm vlookup.

3/ Bạn nên nghe theo lời góp ý của các thành viên nhất là những thành viên lâu năm sẽ đọc tất cả các bài mới. Vì vậy, bạn không nên tạo tiêu đề gây sự chú ý hay nội dung quá màu mè là không cần thiết.

4/ Tôi có đọc bài viết kia của bạn và thấy bạn không nghe lời góp ý của các thành viên nên tôi cũng không có ý kiến gì và bỏ qua bài viết. Vì không muốn vào tranh luận những điều vô bổ, mất thời gian vô ích.

 

[dat8x]

Chạy thử

Sub TongHop()
Dim Ws As Worksheet
Dim Mang
Dim Kq
Dim i, j, k, x
k = Application.Worksheets.Count * 100
ReDim Kq(1 To k, 1 To 6)
k = 0
For Each Ws In Worksheets
    If Ws.Name <> "Tonghop" Then
        For i = 22 To Ws.UsedRange.Rows.Count
            If Ws.Range("B" & i) = "" Or Ws.Range("C" & i) = "" Then Exit For
            k = k + 1
            Kq(k, 1) = Ws.Name
            Kq(k, 2) = Ws.Range("B" & i)
            Kq(k, 3) = Ws.Range("G" & i)
            Kq(k, 4) = IIf(Ws.Range("H" & i) = "", Ws.Range("I" & i), Ws.Range("H" & i))
            Kq(k, 5) = Ws.Range("J" & i)
            Mang = Split(Left(Ws.Range("B15"), Len(Ws.Range("B15")) - 1))
            For j = 0 To UBound(Mang)
                If IsNumeric(Mang(j)) = False Then Mang(j) = ""
            Next j
            Kq(k, 6) = Replace(Application.Trim(Join(Mang)), " ", "/")
        Next i
    End If
Next Ws
With Sheets("Tonghop")
    .Range("A2:F10000").ClearContents
    .Range("A2").Resize(k, 6) = Kq
    .UsedRange.Columns.AutoFit
End With
End Sub

Tks Ban nhe!