Copy dữ liệu từ file này sang file khác

Chia sẻ bởi:hands

★★★★★

‹ Lập trình VBA với Column: chuyển chỉ... Tự động điền dữ liệu từ ô... ›

Quảng cáo

Cám ơn rất nhiều.

Kính gửi: Các Anh, Chị,
Mình có 1 công việc là copy 1 số vùng của "file Mien" sang "file tong hop", như file đính kèm (nội dung yêu cầu có trong file)
file mình chỉ làm mẫu chứ thực tế nhiều hơn, việc copy dán thủ công từng vùng rất lâu, nên nhờ các Anh, Chị lập trình giúp mình với
Cám ơn rất nhiều.

Chào, mình "mò mẫm" VBA cả tháng nay và code được 1 đoạn cách đây vài ngày
Đoạn code của mình là lấy giá trị của 1 sheet cụ thể của 1 file excel đang đóng, Inputbox sẽ yêu cầu bạn nhập tên sheet và vùng cần lấy dữ liệu, tại book hiện hành, tạo 1 sheet mới chứa dữ liệu tổng hợp và liệt kê danh sách file đã lấy ở cột A, vì mình đưa nó lên add-in để sử dụng nhiều nên bắt mình khai báo lằng nhằng mà không viết thẳng vào code, bác thử nhé.
Các tiền bối có vô tình lướt qua thì cho em xin nhận xét, sẵn sàng nhận góp ý ạ.

Sub copfile()
Dim Chonfile As Variant
Dim i As Integer
Dim sh As String
Dim r As String
Dim dong As Integer
Dim cot As Integer
Set wb = ActiveWorkbook
Application.DisplayAlerts = False
Dim tmr As Double
On Error GoTo ErrorHandler
sh = InputBox("Tên sheet can copy", "Thông Báo!") ' "datadcs"
r = InputBox("Vung can copy" & Chr(10) & "Vd: A1:AJ19", "Thông báo!") '"a1:aj19"
Application.ScreenUpdating = False
tmr = Timer()
dong = Range(r).Rows.Count
cot = Range(r).Columns.Count
Chonfile = Application.GetOpenFilename(Title:="Chon file", filefilter:="Excel file (*.xls*), *.xls*", MultiSelect:=True)
Sheets.Add after:=ActiveSheet
For i = 1 To UBound(Chonfile)
     Range(Cells(i, 1), Cells(i, 2)) = Chonfile(i)
     Range(Cells(1, 2), Cells(i, 2)).Replace what:="*", Replacement:=""
     Cells(i, 3).FormulaR1C1 = _
        "=LEFT(RC[-2]:R[6]C[-2],LEN(RC[-2]:R[6]C[-2])-LEN(RC[-1]:R[6]C[-1]))&""[""&RC[-1]:R[6]C[-1]&""]"""
     Cells(i, 3) = Cells(i, 3).Value & sh & "'!" & r
     Range(Cells(i * dong - (dong - 1), 4), Cells(i * dong, cot + 3)).FormulaArray = "='" & Cells(i, 3)
     Range(Cells(i * dong - (dong - 1), 4), Cells(i * dong, cot + 3)) = Range(Cells(i * dong - (dong - 1), 4), Cells(i * dong, cot + 3)).Value
Next
Range("A:A,C:C").Delete
Range("A:A").EntireColumn.AutoFit
ActiveSheet.Name = UBound(Chonfile) & "lot_in_" & Left(Timer() - tmr, 3) & "s"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub
ErrorHandler:
Application.Assistant.DoAlert "THÔNG BÁO", "Ch" & ChrW(432) & "a " & ChrW(273) & ChrW(7911) _
          & " " & ChrW(273) & "i" & ChrW(7873) & "u ki" & ChrW(7879) & "n " & ChrW( _
          273) & ChrW(7875) & " Copy", 0, 4, 0, 0, 0
Exit Sub
End Sub