Copy từ Sheet nhỏ sang Sheet tổng

123456it · 28/10/22

Em có 1 file Excel (Số liệu quan trắc...)gồm các Sheet theo ngày : ngày 1, 2, ..... chạy đến 29,30,31 tùy tháng
Em muốn copy từ B19 đến đến P42 sang Sheet tổng kia(Form_KTTV...)
Sheet tổng kia là tổng hợp những Sheet con trong file nhỏ cũng đc tính theo ngày. Copy luôn vào Cột C3 đến cột Q62.
Các cột là giống nhau chỉ copy paste thôi ạ
Các bác nào xử lý giúp em ạ
Đội ơn các bác

snow25 · 28/10/22

123456it đã viết:
Em có 1 file Excel (Số liệu quan trắc...)gồm các Sheet theo ngày : ngày 1, 2, ..... chạy đến 29,30,31 tùy tháng
Em muốn copy từ B19 đến đến P42 sang Sheet tổng kia(Form_KTTV...)
Sheet tổng kia là tổng hợp những Sheet con trong file nhỏ cũng đc tính theo ngày. Copy luôn vào Cột C3 đến cột Q62.
Các cột là giống nhau chỉ copy paste thôi ạ
Các bác nào xử lý giúp em ạ
Đội ơn các bác

Sao không để trong 1 File mà lại là 2 File.

bebo021999 · 28/10/22

Nhập chung sheet data vào file chính rồi chạy code này nhé:

PHP:

Option Explicit
Sub add()
Dim ws As Worksheet, lcell As Range
Sheets("Data").Range("C3:Q746").ClearContents ' xoa du lieu cu tren sheet data
For Each ws In Sheets
    Set lcell = Sheets("Data").Cells(Rows.Count, "C").End(xlUp).Offset(1, 0) ' xac dinh o dau tien chua co du lieu cua cot C sheet data
    If ws.Name <> "Data" And IsNumeric(ws.Name) Then
        ws.Range("B19:P42").Copy lcell
    End If
Next
End Sub

123456it · 28/10/22

bebo021999 đã viết:

Nhập chung sheet data vào file chính rồi chạy code này nhé:

PHP:

Option Explicit
Sub add()
Dim ws As Worksheet, lcell As Range
Sheets("Data").Range("C3:Q746").ClearContents ' xoa du lieu cu tren sheet data
For Each ws In Sheets
    Set lcell = Sheets("Data").Cells(Rows.Count, "C").End(xlUp).Offset(1, 0) ' xac dinh o dau tien chua co du lieu cua cot C sheet data
    If ws.Name <> "Data" And IsNumeric(ws.Name) Then
        ws.Range("B19:P42").Copy lcell
    End If
Next
End Sub

Nếu nó sai cột thì e thay tọa độ cột vào nhưng nó cứ open..ấn mãi đến mười mấy lần bác ạ

Bài đã được tự động gộp: 28/10/22

snow25 đã viết:
Sao không để trong 1 File mà lại là 2 File.

Dạ... 1 file cũng dc ạ.. bác có cách nào xử lý toàn vẹn ko ạ. Cám ơn bác trước

Ronaldinho7 · 28/10/22

123456it đã viết:
Nếu nó sai cột thì e thay tọa độ cột vào nhưng nó cứ open..ấn mãi đến mười mấy lần bác ạ

Bài đã được tự động gộp: 28/10/22

Dạ... 1 file cũng dc ạ.. bác có cách nào xử lý toàn vẹn ko ạ. Cám ơn bác trước

Bạn kiểm tra kết quả xem đúng không nhé!
Nhấn update, hộp thoại mở ra bạn chọn tới file [số liệu quan...] ở #1 ha!

PHP:

Option Explicit
Sub Get_Data()
    Dim Fso As Object, Item, Wb As Workbook, Lr&, Ws As Worksheet
    Dim Arr(), Res(1 To 100000, 1 To 16), i&, j&, k&
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Add "Microsoft Excel File", "*.xl*", 1
        If Not .Show Then Exit Sub
            For Each Item In .SelectedItems
                Set Wb = Workbooks.Open(Item)
                For Each Ws In Worksheets
                    With Ws
                        Arr = .Range("A19:P42").Value
                        For i = 1 To UBound(Arr)
                            k = k + 1
                            For j = 1 To 16
                                Res(k, j) = Arr(i, j)
                            Next j
                        Next i
                    End With
                Next Ws
                Wb.Close False
            Next
        End With
    If k Then
        With Sheets("Data")
            .Range("C3:Q100000").ClearContents
            .Range("C3").Resize(k, 16).Value = Res
            .Range("C3").CurrentRegion.Borders.LineStyle = 1
        End With
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "Hoan Thanh"
    Set Fso = Nothing
End Sub

123456it · 30/10/22

Zl: 0933707265 đã viết:

Bạn kiểm tra kết quả xem đúng không nhé!
Nhấn update, hộp thoại mở ra bạn chọn tới file [số liệu quan...] ở #1 ha!

PHP:

Option Explicit
Sub Get_Data()
    Dim Fso As Object, Item, Wb As Workbook, Lr&, Ws As Worksheet
    Dim Arr(), Res(1 To 100000, 1 To 16), i&, j&, k&
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Add "Microsoft Excel File", "*.xl*", 1
        If Not .Show Then Exit Sub
            For Each Item In .SelectedItems
                Set Wb = Workbooks.Open(Item)
                For Each Ws In Worksheets
                    With Ws
                        Arr = .Range("A19:P42").Value
                        For i = 1 To UBound(Arr)
                            k = k + 1
                            For j = 1 To 16
                                Res(k, j) = Arr(i, j)
                            Next j
                        Next i
                    End With
                Next Ws
                Wb.Close False
            Next
        End With
    If k Then
        With Sheets("Data")
            .Range("C3:Q100000").ClearContents
            .Range("C3").Resize(k, 16).Value = Res
            .Range("C3").CurrentRegion.Borders.LineStyle = 1
        End With
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "Hoan Thanh"
    Set Fso = Nothing
End Sub

Máy e cứ báo thế này mà e dùng mọi cách ko sửa dc ạ

Ronaldinho7 · 30/10/22

123456it đã viết:
Máy e cứ báo thế này mà e dùng mọi cách ko sửa dc ạ

Bạn tham khảo link dưới nhé!

enable macro trong excel - Tìm trên Google

123456it · 30/10/22

Zl: 0933707265 đã viết:

Bạn kiểm tra kết quả xem đúng không nhé!
Nhấn update, hộp thoại mở ra bạn chọn tới file [số liệu quan...] ở #1 ha!

PHP:

Option Explicit
Sub Get_Data()
    Dim Fso As Object, Item, Wb As Workbook, Lr&, Ws As Worksheet
    Dim Arr(), Res(1 To 100000, 1 To 16), i&, j&, k&
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Add "Microsoft Excel File", "*.xl*", 1
        If Not .Show Then Exit Sub
            For Each Item In .SelectedItems
                Set Wb = Workbooks.Open(Item)
                For Each Ws In Worksheets
                    With Ws
                        Arr = .Range("A19:P42").Value
                        For i = 1 To UBound(Arr)
                            k = k + 1
                            For j = 1 To 16
                                Res(k, j) = Arr(i, j)
                            Next j
                        Next i
                    End With
                Next Ws
                Wb.Close False
            Next
        End With
    If k Then
        With Sheets("Data")
            .Range("C3:Q100000").ClearContents
            .Range("C3").Resize(k, 16).Value = Res
            .Range("C3").CurrentRegion.Borders.LineStyle = 1
        End With
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "Hoan Thanh"
    Set Fso = Nothing
End Sub

ko đúng bác ạ.. dữ liệu nó nhảy loạn lên

Ronaldinho7 · 30/10/22

123456it đã viết:
ko đúng bác ạ.. dữ liệu nó nhảy loạn lên

Bạn có dùng file có code (mình viết) và lấy dữ liệu ở file #1 chứ?
Có thể đính kèm cả 2 file để mình xem sai ở đâu không?

123456it · 30/10/22

Zl: 0933707265 đã viết:
Bạn có dùng file có code (mình viết) và lấy dữ liệu ở file #1 chứ?
Có thể đính kèm cả 2 file để mình xem sai ở đâu không?

FIle tháng 8 là file upload ạ
E lấy file mẫu của bác và em chọn update, chọn file tháng 7 hoặc tháng 8 có những số liệu ko bít từ đâu vào ạ..
Cám ơn bác trước

Ronaldinho7 · 30/10/22

123456it đã viết:
FIle tháng 8 là file upload ạ
E lấy file mẫu của bác và em chọn update, chọn file tháng 7 hoặc tháng 8 có những số liệu ko bít từ đâu vào ạ..
Cám ơn bác trước

Do file bạn gửi ở #1 khác với file mới nên kết quả sẽ trả sai.
file đính kèm phía dưới bạn chạy code ở file [FORM_KTTV_NhoQue1_072022 (4)]
Sau đó chọn tới các file muốn tổng hợp
- [ Bảng số liệu quan trắc 07-2021]
- [Bảng số liệu quan trắc 08-2021]
Rồi kiểm tra kết quả ha!

SA_DQ · 30/10/22

bebo021999 đã viết:
Nhập chung sheet data vào file chính rồi chạy code này nhé:

PHP:

Option Explicit Sub add() . . . . . . End Sub

(1) Chú mày chưa có lệnh màn hình không được rung lắc!
(2) Chắt ăn hơn là chép theo ngày bằng cách nào đó; Tuy tăng sự dài dòng trong 'Code' nhưng sẽ ngon giấc khi xuống ca!
(3) Chúc chú mày vui suốt ngày!

Copy từ Sheet nhỏ sang Sheet tổng

123456it

Thành viên chính thức

File đính kèm

snow25

Thành viên gạo cội

bebo021999

Thành viên gạo cội

File đính kèm

123456it

Thành viên chính thức

File đính kèm

Ronaldinho7

Zl: 0707315985

File đính kèm

123456it

Thành viên chính thức

File đính kèm

Ronaldinho7

Zl: 0707315985

123456it

Thành viên chính thức

Ronaldinho7

Zl: 0707315985

123456it

Thành viên chính thức

File đính kèm

Ronaldinho7

Zl: 0707315985

File đính kèm

SA_DQ

/(hông là gì!

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng