Nhờ giúp đỡ code vb! (1 người xem)

[dungnvps]

Chào các bác, mình có bào này cần nhờ giúp đỡ!
Mình có 3 file excel 1 file chứa dữ liệu 1 file để copy dữ liệu từ file 1 sang và 1file trung gian chứa code
Ở file chứa code sẽ có chổ để nhập tên của file 1 và file 2 khi ấn vào button copy dữ liệu thì dữ liệu từ file 1 sang file 2
Nhờ bác nào cao tay giúp đỡ mình!!
Tks all!!
Ví dụ:

 

[quanluu]

Chào các bác, mình có bào này cần nhờ giúp đỡ!
Mình có 3 file excel 1 file chứa dữ liệu 1 file để copy dữ liệu từ file 1 sang và 1file trung gian chứa code
Ở file chứa code sẽ có chổ để nhập tên của file 1 và file 2 khi ấn vào button copy dữ liệu thì dữ liệu từ file 1 sang file 2
Nhờ bác nào cao tay giúp đỡ mình!!
Tks all!!
Ví dụ:
View attachment 164050

Tên môn sao lại có A,B? nó là cái gì và bạn cần lấy dữ liệu nư thế nào?

 

[dungnvps]

Tên môn sao lại có A,B? nó là cái gì và bạn cần lấy dữ liệu nư thế nào?

Cám ơn bạn đã xem.
File của mình dựa theo file gốc nên phải là thêm cái A,B cho giống. Mình muốn lay 2 cột điểm và điểm tb của toán văn anh copy sang cột tương tự của file "Filecopydulieu"

 

[quanluu]

Cám ơn bạn đã xem.
File của mình dựa theo file gốc nên phải là thêm cái A,B cho giống. Mình muốn lay 2 cột điểm và điểm tb của toán văn anh copy sang cột tương tự của file "Filecopydulieu"

Dữ liệu có 3 dòng thui hả bạn? nếu thế thì code làm gì cho mệt.

 

[dungnvps]

Dữ liệu có 3 dòng thui hả bạn? nếu thế thì code làm gì cho mệt.

Này là file mẫu nên mình chỉ nhập vài dòng như vậy thôi, thật ra file gốc rất nhiều nên khi nhập có thể sai sót vì vậy nên mình cần dùng code..mong bạn giúp đỡ

 

[quanluu]

Này là file mẫu nên mình chỉ nhập vài dòng như vậy thôi, thật ra file gốc rất nhiều nên khi nhập có thể sai sót vì vậy nên mình cần dùng code..mong bạn giúp đỡ

Như bạn nói lấy điểm của 3 môn toán văn anh, nhưng nếu có nhiều dòng ( nhiều giá trị toán, vắn, anh) thì phân biết nó kiểu gì chứ? hic

 

[dungnvps]

Như bạn nói lấy điểm của 3 môn toán văn anh, nhưng nếu có nhiều dòng ( nhiều giá trị toán, vắn, anh) thì phân biết nó kiểu gì chứ? hic

bạn có thể giúp mình file test này ko, còn áp dụng file gốc mình sẽ tìm cách để áp dụng

 

[quanluu]

bạn có thể giúp mình file test này ko, còn áp dụng file gốc mình sẽ tìm cách để áp dụng

Tùy ý bạn thui

Sub Button2_Click()
Dim wbsource As Workbook, wbcopy As Workbook, sourcepath, despath As String
Dim lr, k As Integer
Dim arr1(), arr2(), arr3()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
sourcepath = Cells(1, 2): despath = Cells(2, 2)
Set wbsource = Workbooks.Open(sourcepath)
With wbsource.ActiveSheet
    lr = .Range("A65000").End(3).Row
    ReDim arr1(1 To lr, 1 To 1), arr2(1 To lr, 1 To 1), arr3(1 To lr, 1 To 1)
    For i = 1 To lr
        If .Cells(i, 1) = "Toan" Or .Cells(i, 1) = "Van" Or .Cells(i, 1) = "Anh" Then
            k = k + 1
            arr1(k, 1) = .Cells(i, 1)
            arr2(k, 1) = .Cells(i, 2)
            arr3(k, 1) = .Cells(i, 4)
        End If
    Next
End With
wbsource.Close False
Set wbcopy = Workbooks.Open(despath)
With wbcopy.ActiveSheet
    .Range("A2").Resize(k, 1) = arr1
    .Range("F2").Resize(k, 1) = arr2
    .Range("G2").Resize(k, 1) = arr3
End With
wbcopy.Close True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[dungnvps]

Tùy ý bạn thui

Sub Button2_Click()
Dim wbsource As Workbook, wbcopy As Workbook, sourcepath, despath As String
Dim lr, k As Integer
Dim arr1(), arr2(), arr3()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
sourcepath = Cells(1, 2): despath = Cells(2, 2)
Set wbsource = Workbooks.Open(sourcepath)
With wbsource.ActiveSheet
    lr = .Range("A65000").End(3).Row
    ReDim arr1(1 To lr, 1 To 1), arr2(1 To lr, 1 To 1), arr3(1 To lr, 1 To 1)
    For i = 1 To lr
        If .Cells(i, 1) = "Toan" Or .Cells(i, 1) = "Van" Or .Cells(i, 1) = "Anh" Then
            k = k + 1
            arr1(k, 1) = .Cells(i, 1)
            arr2(k, 1) = .Cells(i, 2)
            arr3(k, 1) = .Cells(i, 4)
        End If
    Next
End With
wbsource.Close False
Set wbcopy = Workbooks.Open(despath)
With wbcopy.ActiveSheet
    .Range("A2").Resize(k, 1) = arr1
    .Range("F2").Resize(k, 1) = arr2
    .Range("G2").Resize(k, 1) = arr3
End With
wbcopy.Close True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Ok.Cám ơn bạn nhiều lần trước cũng nhờ bạn giúp đỡ 1 lần