Copy và paste tự động vào khoảng trống

[Kem88]

Xin chào anh chị em trong diễn đàn ạ, em có 1 vấn đề mong muốn nhờ ace trong diễn đàn chỉ giáo giúp e xem có code nào phù hợp không với ạ.
Em có 2 file excel 1 và 2, file 2 sẽ có nhiều kết quả(form vẫn như nhau khác mỗi tên và số liệu thôi ạ), giờ em muốn cop kết quả ở file 2 cụ thể là ô (W12:Y21) sang file 1 (3 cột F,G,H) nhưng paste theo kiểu trống từ dòng nào thì paste luôn vào dòng ấy trở xuống ý ạ vì là dữ liệu cập nhật liên tục(ô đầu tiên cần kiểm tra là F8). Mong các ac chỉ giáo, em xin cảm ơn ạ!

 

[Kem88]

Các cao nhân chỉ giáo giúp e với ạ!

 

[tieutuvodanh192]

Hạ nhân vô tình đi ngang qua, đang ngẩn ngơ phân vân có nên lick vào file zip ở bài 1, bỗng chốc thấy bài 2 hiển linh. Xin lỗi đã làm phiền các hạ, thân ái - quyết thắng.

 

[Kem88]

Hạ nhân vô tình đi ngang qua, đang ngẩn ngơ phân vân có nên lick vào file zip ở bài 1, bỗng chốc thấy bài 2 hiển linh. Xin lỗi đã làm phiền các hạ, thân ái - quyết thắng.

hix ! bác lại bắt bẻ lời nói rồi

 

[tieutuvodanh192]

Thật ra nếu mà bắt bẻ thì bài của bạn có nhiều chỗ để bắt và bẻ thành nhiều đoạn lắm, to nhất là trong file 2 của bạn gửi lên mình thấy vùng W12:Y21 trống lơ trống lốc chứ có cái gì đâu mà copy, với lại đó là file csv mà bạn mô tả bạn có 2 file excel.
Nhưng thôi lỡ bước chân vào đây rồi nên mình cào đại cho bạn mấy dòng code, bạn tự test xem nha.
Bạn copy code này vào file số 1, sau đó chạy code. Sẽ có hộp thoại hiện lên cho phép bạn chọn 1 hoặc nhiều file excel (đuôi File có dạng .xlsx hoặc .xls), các file được chọn sẽ copy dữ liệu từ vùng W12:Y21 và dán vào nối tiếp nhau từ cột F:H ở file 1, mặc định bắt đầu từ dòng số 8 nếu cột F đang trống.
Vì bạn không nói rõ tên và số sheet muốn copy dữ liệu nên mình để mặc định chỉ lấy sheet 1 (sheet đầu tiền trong mỗi file được chọn để copy dữ liệu), bạn có thể chỉ định lại tên sheet nếu bạn muốn. Set ws = wb.Worksheets(1)
Chúc bạn thành công.

Sub ABC()
Application.ScreenUpdating = False
    Dim ChonFile As Variant
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim Copy As Range
    Dim Paste As Range
    Dim lr As Long
    ChonFile = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Chon file", MultiSelect:=True)
    If IsArray(ChonFile) Then
        Set Paste = ThisWorkbook.Worksheets(1).Range("F8")
        For Each File In ChonFile
            Set wb = Workbooks.Open(File)
            Set ws = wb.Worksheets(1)
            Set Copy = ws.Range("W12:Y21")
            lr = ThisWorkbook.Worksheets(1).Cells(Rows.Count, "F").End(xlUp).Row
            Set Paste = ThisWorkbook.Worksheets(1).Cells(lr, "F").Offset(1, 0)
            Paste.Resize(Copy.Rows.Count, Copy.Columns.Count).Value = Copy.Value
            wb.Close savechanges:=False
        Next File
    Else
        MsgBox "Khong co File nao duoc chon"
    End If
Application.ScreenUpdating = True
End Sub

 

[Kem88]

Thật ra nếu mà bắt bẻ thì bài của bạn có nhiều chỗ để bắt và bẻ thành nhiều đoạn lắm, to nhất là trong file 2 của bạn gửi lên mình thấy vùng W12:Y21 trống lơ trống lốc chứ có cái gì đâu mà copy, với lại đó là file csv mà bạn mô tả bạn có 2 file excel.
Nhưng thôi lỡ bước chân vào đây rồi nên mình cào đại cho bạn mấy dòng code, bạn tự test xem nha.
Bạn copy code này vào file số 1, sau đó chạy code. Sẽ có hộp thoại hiện lên cho phép bạn chọn 1 hoặc nhiều file excel (đuôi File có dạng .xlsx hoặc .xls), các file được chọn sẽ copy dữ liệu từ vùng W12:Y21 và dán vào nối tiếp nhau từ cột F:H ở file 1, mặc định bắt đầu từ dòng số 8 nếu cột F đang trống.
Vì bạn không nói rõ tên và số sheet muốn copy dữ liệu nên mình để mặc định chỉ lấy sheet 1 (sheet đầu tiền trong mỗi file được chọn để copy dữ liệu), bạn có thể chỉ định lại tên sheet nếu bạn muốn. Set ws = wb.Worksheets(1)
Chúc bạn thành công.

Sub ABC()
Application.ScreenUpdating = False
    Dim ChonFile As Variant
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim Copy As Range
    Dim Paste As Range
    Dim lr As Long
    ChonFile = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Chon file", MultiSelect:=True)
    If IsArray(ChonFile) Then
        Set Paste = ThisWorkbook.Worksheets(1).Range("F8")
        For Each File In ChonFile
            Set wb = Workbooks.Open(File)
            Set ws = wb.Worksheets(1)
            Set Copy = ws.Range("W12:Y21")
            lr = ThisWorkbook.Worksheets(1).Cells(Rows.Count, "F").End(xlUp).Row
            Set Paste = ThisWorkbook.Worksheets(1).Cells(lr, "F").Offset(1, 0)
            Paste.Resize(Copy.Rows.Count, Copy.Columns.Count).Value = Copy.Value
            wb.Close savechanges:=False
        Next File
    Else
        MsgBox "Khong co File nao duoc chon"
    End If
Application.ScreenUpdating = True
End Sub

Cảm ơn bạn đã giúp! thực ra file 2 vùng cần cop vẫn có số liệu mà bạn đổi nó sang định dạng khác nên nó bị mất, và đúng là nó đuôi .csv thật vì chạy máy nó mặc định xuất ra kq đuôi như vậy,mình có thử sửa code bạn cho thêm đuôi .csv mà ko chạy được,bạn có cách nào áp dụng cho file đuôi .csv không,và có cách nào mà cái code đấy mình không phải add file 1 hay file 2 mà làm sang file thứ 3 có được không.

 

[tieutuvodanh192]

Cách thì chắc có, nhưng khả năng của mình chỉ tới vậy. Bạn chờ các thành viên khác xem sao.

 

[Kem88]

Cách thì chắc có, nhưng khả năng của mình chỉ tới vậy. Bạn chờ các thành viên khác xem sao.

ok cảm ơn bạn nhiều nhé!