tổng hợp dữ liệu tự động từ nhiều file excel

[svhsph]

hi các bạn
các bạn giúp bài toán này với ạ

em cần tổng hợp dữ liệu từ rất nhều cá nhân chuyển về theo form định sẵn trước

Ten  Tuoi gioi Luong
 A     23    2    4

Ten  Tuoi gioi Luong
 B     25    1    9

Ten  Tuoi gioi Luong
 C     24    2    6

Em muon sau khi chay 1 cau lenh/cach gi do, se tong hop thanh 1 file la tong hop voi cac hang la ten tuong ung va so lieu tuong ung duoc cap nhat tu cac file kia,
chứ ko phải mở file để copy từng hàng một

xin cac ban chi giup cach don gian nhat, va chi tiet 1 chut
cam on cac ban nhieu

 

[tongquangtuyen]

Bạn thử tìm trên diễn đàn nha ! Mình nhớ đã có đọc qua trên GPEX giống như yêu cấu của bạn.Bạn gõ tìm " Gộp dữ liệu từ nhiều file" nha

 

[thehungqnu]

Tổng hợp file trong 1 thư mục

Bạn dùng code này của Bạn nào đó trên diễn đàn mình không nhớ, đã sữa lại cho theo ý svhsph ok rồi.

Dim SourceWb As Workbook, TgtWb As Workbook
Dim FolderName As String, wbName As String, wName As String, shName As String
Dim eRow As Long, endR As Long
Dim i As Integer
Option Explicit
Sub Tong_hop()
With Application
  .DisplayAlerts = False
  .ScreenUpdating = False
  .Calculation = xlCalculationManual
End With
FolderName = ActiveWorkbook.Path
Set SourceWb = ThisWorkbook
wName = ActiveWorkbook.Name
wbName = Dir(FolderName & "\" & "*.xls")
With Sheets("sheet1")
  .Range("A5:E65000").ClearContents
End With
eRow = 2
While wbName <> ""
  If wbName <> wName Then
    If bWorkbookIsOpen(wbName) Then
      Windows(wbName).Activate
    Else
      Workbooks.Open Filename:=FolderName & "\" & wbName
    End If
    Set TgtWb = ActiveWorkbook
    shName = "Sheet1" 'sheet can lay Dl
    If WksExists(shName) = True Then
        Sheets(shName).Select
        endR = Range("A65000").End(xlUp).Row
        SourceWb.Sheets("Sheet1").Range("A" & eRow & ":D" & eRow + endR - 2).Value = Range("A2:D" & endR).Value
        SourceWb.Sheets("Sheet1").Range("E" & eRow & ":E" & eRow + endR - 2).Value = wbName
        eRow = eRow + endR - 1
    End If
    TgtWb.Close
  End If
  wbName = Dir
Wend
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
MsgBox ("Xong roi chuc vui!")
End Sub
Function WksExists(wksName As String) As Boolean
    On Error Resume Next
    WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function
Function bWorkbookIsOpen(rsWbkName As String) As Boolean
    On Error Resume Next
    bWorkbookIsOpen = CBool(Len(Workbooks(rsWbkName).Name) > 0)
End Function

 

[svhsph]

cam on bạn nhiều, mình sẽ phải học về VBA để có thể hiểu chi tiết vân đề
n ,

Bạn dùng code này của Bạn nào đó trên diễn đàn mình không nhớ, đã sữa lại cho theo ý svhsph ok rồi.

Dim SourceWb As Workbook, TgtWb As Workbook
Dim FolderName As String, wbName As String, wName As String, shName As String
Dim eRow As Long, endR As Long
Dim i As Integer
Option Explicit
Sub Tong_hop()
With Application
  .DisplayAlerts = False
  .ScreenUpdating = False
  .Calculation = xlCalculationManual
End With
FolderName = ActiveWorkbook.Path
Set SourceWb = ThisWorkbook
wName = ActiveWorkbook.Name
wbName = Dir(FolderName & "\" & "*.xls")
With Sheets("sheet1")
  .Range("A5:E65000").ClearContents
End With
eRow = 2
While wbName <> ""
  If wbName <> wName Then
    If bWorkbookIsOpen(wbName) Then
      Windows(wbName).Activate
    Else
      Workbooks.Open Filename:=FolderName & "\" & wbName
    End If
    Set TgtWb = ActiveWorkbook
    shName = "Sheet1" 'sheet can lay Dl
    If WksExists(shName) = True Then
        Sheets(shName).Select
        endR = Range("A65000").End(xlUp).Row
        SourceWb.Sheets("Sheet1").Range("A" & eRow & ":D" & eRow + endR - 2).Value = Range("A2:D" & endR).Value
        SourceWb.Sheets("Sheet1").Range("E" & eRow & ":E" & eRow + endR - 2).Value = wbName
        eRow = eRow + endR - 1
    End If
    TgtWb.Close
  End If
  wbName = Dir
Wend
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
MsgBox ("Xong roi chuc vui!")
End Sub
Function WksExists(wksName As String) As Boolean
    On Error Resume Next
    WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function
Function bWorkbookIsOpen(rsWbkName As String) As Boolean
    On Error Resume Next
    bWorkbookIsOpen = CBool(Len(Workbooks(rsWbkName).Name) > 0)
End Function

 

[thehungqnu]

Có sách lập trình VBA trong excel của Phan Tự Hướng mình thấy rất hay Bạn có thể đọc tham khảo thêm. Chúc vui!