Option Explicit
Dim destWB As Workbook, sourceWB As Workbook
'Dim destWk As Worksheet, sourceWk As Worksheet
Dim sourceRange As Range, destrange As Range
Dim intRow As Integer
Dim smallrng As Range
'Public Const SWbName As String = "CloseIniFileToVBA.xls" 'to all procedures in all modules. Not allowed in procedures
'de no cung kg dong duoc ini file ???
Public Const DongFlag As String = "A12"
Sub copy_to_another_workbook() ' Area to Range lien tuc, chep tung cai, bang resize
Dim SWbName As String
SWbName = "HDGTGTToData_IniFile.xls"
Dim WbIniFile As Workbook
'Dim Lr As Long
Application.ScreenUpdating = False
MsgBox "THAY doi o Public const khi chay so hoa don moi, kiem tra khi on dinh roi se dua vao vong lap"
'Lay ten source va destination,sau do dong lai
If bIsBookOpen(SWbName) Then
Set WbIniFile = Workbooks(SWbName)
Else
Set WbIniFile = Workbooks.Open(ThisWorkbook.Path & "\" & SWbName)
End If
With WbIniFile.Worksheets("Sheet1")
intRow = .Range(DongFlag).Row
If bIsBookOpen(.Cells(intRow, 2)) Then
Set sourceWB = Nothing
Set sourceWB = Workbooks(.Cells(intRow, 2)) ' bi loi o day neu da mo va chua dung nothing,dung cho lan 2
Else
Set sourceWB = Workbooks.Open(Left(ThisWorkbook.Path, 3) & "PTC" & "\" & .Cells(intRow, 6) & "\" & .Cells(intRow, 2))
'Set sourceWk = Workbooks(.Cells(intRow, 2)).Worksheets(.Cells(intRow, 3)) khg the dung wk duoc, tot nhat cu theo cai co san da
End If
If bIsBookOpen(.Cells(intRow, 7)) Then
Set destWB = Workbooks(.Cells(intRow, 7))
Else
Set destWB = Workbooks.Open(Left(ThisWorkbook.Path, 3) & "PTC" & "\" & .Cells(intRow, 11) & "\" & .Cells(intRow, 7))
End If
End With
WbIniFile.Close True
Set WbIniFile = Nothing
' Chep sang tabe1 cua data
'Windows("2007HDGTGT_Data.xls").Activate
Dim LastPlc As Integer, i As Integer
i = 1
With destWB 'dung with qua hay va thuan tien,nhung hay bat dau bang Activate de code chay on ding da
LastPlc = Application.CountA(.Worksheets("Data").Range("a:a")) + 1 'Find last cell/row plus one
End With
For Each smallrng In sourceWB.Worksheets("Sheet1").Range("e2,e3,i4,i12,i15").Areas
'With smallrng
Set destrange = Worksheets("Data").Cells(LastPlc, i)
'End With
destrange.Value = smallrng.Value
i = i + 1
Next smallrng
'' Chep sang tabe2 cua data
Dim SoDong As Integer, LastPlc2 As Integer
Dim DataCount As Range
Set DataCount = Worksheets("Data").Range("g:g")
LastPlc2 = Application.CountA(DataCount) + 1 'kieu nay hay hon xlDown phai co min 2 cell, nhung phai chon duoc vung dem co dinh
'sourceWB.Worksheets("Sheet1").Activate
'Mot cai do cua xlDown la vung data phai co it nhat 2 Cells thi moi dung, do do doi a19->17, nen doc them NotEmpty cho nay
With sourceWB.Worksheets("Sheet1")
SoDong = Application.WorksheetFunction.CountA(.Range("A17:A" & .Range("a18").End(xlDown).Row)) - 2
End With
'destWB.Worksheets("Data").Activate
i = 0
With Worksheets("Data")
For i = 0 To SoDong - 1
'Dim i2 As Integer
'i2 = 7
'For Each smallrng In sourceWB.Worksheets("Sheet1").Range("e3")
'.Cells(LastPlc2, i2) = smallrng
' i2 = i2 + 1
.Cells(LastPlc2, 7) = sourceWB.Worksheets("Sheet1").Range("e3")
.Cells(LastPlc2, 8) = sourceWB.Worksheets("Sheet1").Range("a19").Offset(i, 0)
.Cells(LastPlc2, 9) = sourceWB.Worksheets("Sheet1").Range("b19").Offset(i, 0)
.Cells(LastPlc2, 9).WrapText = False
.Cells(LastPlc2, 10) = sourceWB.Worksheets("Sheet1").Range("c19").Offset(i, 0)
.Cells(LastPlc2, 11) = sourceWB.Worksheets("Sheet1").Range("d19").Offset(i, 0)
.Cells(LastPlc2, 12) = sourceWB.Worksheets("Sheet1").Range("e19").Offset(i, 0)
' Next smallrng
LastPlc2 = Application.CountA(DataCount) + 1
Next
End With
sourceWB.Close True
'destWB.Close True
Set sourceWB = Nothing
'Set destWB = Nothing
CloseMe
End Sub
Sub CloseMe()
ThisWorkbook.Close True
End Sub
, 
