quachlamnhi.tnt
Thành viên mới

- Tham gia
- 10/6/14
- Bài viết
- 1
- Được thích
- 0
Sub GetSheets()
Dim Path As String
Dim Filename As String
Dim Title As String
Dim Text As String
Dim Wb As Workbook
Dim Ws As Worksheet
Dim i As Long
Dim j As Long
Dim ArrayData()
Application.ScreenUpdating = False
Path = ThisWorkbook.Path & "\"
Title = "File T" & ChrW(7893) & "ng H" & ChrW(7907) & "p."
Text = "C" & ChrW(7853) & "p nh" & ChrW(7853) & "t thành công."
For i = 1 To 12
Filename = Dir(Path & "TONG HOP " & i & ".xlsm")
Sheets("Master").Select
j = 0
Do While Filename <> ""
Set Wb = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True)
For Each Ws In Wb.Sheets
Ws.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Wb.Name
If Ws.Name <> ActiveSheet.Name Then
j = j + 1
ArrayData(j) = Ws.Name & "!R10C6:R300C11"
End If
Next Ws
Wb.Close
Filename = Dir()
Loop
Next i
ReDim ArrayData(1 To ActiveWorkbook.Worksheets.Count - 1)
Range("B10").Select
Selection.Consolidate Sources:=ArrayData(), _
Function:=xlSum, toprow:=False, leftcolumn:=True, createlinks:=False
Application.ScreenUpdating = True
Application.Assistant.DoAlert Title, Text, 0, 4, 0, 0, 0
End Sub
Kính chào các anh chị, em có đoạn code như trên, mục đích làm để tổng hợp khoảng 12 file tổng hợp hàng tháng vào 1 file master rồi sau đó em muốn dùng consolidate tổng hợp luôn dữ liệu từ các sheet mới tổng hợp vào sheet Master luôn. Nhưng bị báo lỗi "Subcription out of range". Kính mong các anh chị cao thủ chỉ dạy.
Dim Path As String
Dim Filename As String
Dim Title As String
Dim Text As String
Dim Wb As Workbook
Dim Ws As Worksheet
Dim i As Long
Dim j As Long
Dim ArrayData()
Application.ScreenUpdating = False
Path = ThisWorkbook.Path & "\"
Title = "File T" & ChrW(7893) & "ng H" & ChrW(7907) & "p."
Text = "C" & ChrW(7853) & "p nh" & ChrW(7853) & "t thành công."
For i = 1 To 12
Filename = Dir(Path & "TONG HOP " & i & ".xlsm")
Sheets("Master").Select
j = 0
Do While Filename <> ""
Set Wb = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True)
For Each Ws In Wb.Sheets
Ws.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Wb.Name
If Ws.Name <> ActiveSheet.Name Then
j = j + 1
ArrayData(j) = Ws.Name & "!R10C6:R300C11"
End If
Next Ws
Wb.Close
Filename = Dir()
Loop
Next i
ReDim ArrayData(1 To ActiveWorkbook.Worksheets.Count - 1)
Range("B10").Select
Selection.Consolidate Sources:=ArrayData(), _
Function:=xlSum, toprow:=False, leftcolumn:=True, createlinks:=False
Application.ScreenUpdating = True
Application.Assistant.DoAlert Title, Text, 0, 4, 0, 0, 0
End Sub
Kính chào các anh chị, em có đoạn code như trên, mục đích làm để tổng hợp khoảng 12 file tổng hợp hàng tháng vào 1 file master rồi sau đó em muốn dùng consolidate tổng hợp luôn dữ liệu từ các sheet mới tổng hợp vào sheet Master luôn. Nhưng bị báo lỗi "Subcription out of range". Kính mong các anh chị cao thủ chỉ dạy.