copy paste

dl0506

1. Public Function GetData_D365(ByVal wkb_EachSubFile As Workbook) As Boolean
   
2.     Dim myWkb As Workbook
   
3.     Dim myCopyToSheet As Worksheet
   
4.     Dim wks_SubFileSheet As Worksheet
   
5.     Dim iLastRow As Long
   
6.     Dim iLoop, jLoop As Long
   
7.     Dim iCopyRow_Start, iCopyRow_End As Long
   
8.     Dim iCopyToRow As Long
   
9.     Dim rngTitle_CopyTo As Range
   
10.     Dim rngTitle_CopyFrom As Range
    
11.     Dim i, j As Long
    
12.     Dim arrTitle_CopyFrom()
    
13.     Dim arrTitle_CopyTo()
    
14.     Dim iLoopTitle As Long
    
15. 
    
16.     '/ load payment information
    
17.     GetData_D365 = False
    
18.     Set myWkb = ThisWorkbook
    
19.     Set myCopyToSheet = myWkb.Worksheets("TemplateSheet")
    
20.     Set wks_SubFileSheet = wkb_EachSubFile.ActiveSheet
    
21.    
    
22.     If Not dic_LoadTitle Is Nothing Then
    
23.         dic_LoadTitle.RemoveAll
    
24.     End If
    
25.     Call GetLoadTitle("D365")
    
26.     Erase arrTitle_CopyFrom
    
27.     Erase arrTitle_CopyTo
    
28.     arrTitle_CopyFrom = dic_LoadTitle.keys
    
29.     arrTitle_CopyTo = dic_LoadTitle.Items
    
30.    
    
31.     With wks_SubFileSheet
    
32.         .Range("A:ZZ").EntireColumn.Hidden = False
    
33.         .Rows("1:65536").EntireRow.Hidden = False
    
34.         .AutoFilterMode = False
    
35.         iLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
    
36.         For iLoop = 1 To iLastRow
    
37.             If .Cells(iLoop, 2).Value = GetValueByKey("Title_Payment_StartRange") Then
    
38.                 iCopyRow_Start = iLoop + 1
    
39.                 For jLoop = iLoop + 1 To iLastRow
    
40.                     If Trim(.Cells(jLoop, 2).Value) = GetValueByKey("Title_Payment_EndRange") Then
    
41.                         iCopyRow_End = jLoop - 1
    
42.                         iLoop = jLoop
    
43.                         '/ copy process
    
44.                         iCopyToRow = myCopyToSheet.Range("H1048576").End(xlUp).Row + 1
    
45.                         If iCopyRow_End - iCopyRow_Start = 0 Then
    
46.                             '/ copy to output template Sheet
    
47.                             For iLoopTitle = 0 To UBound(arrTitle_CopyFrom)
    
48.                                 Set rngTitle_CopyTo = myCopyToSheet.Rows("1:1").Find(arrTitle_CopyTo(iLoopTitle), Lookat:=xlWhole)
    
49.                                 If Not rngTitle_CopyTo Is Nothing Then
    
50.                                     Set rngTitle_CopyFrom = .Rows(iCopyRow_Start - 1).Find(arrTitle_CopyFrom(iLoopTitle), Lookat:=xlWhole)
    
51.                                     If Not rngTitle_CopyFrom Is Nothing Then
    
52.                                         .Cells(iCopyRow_End, rngTitle_CopyFrom.Column).Copy myCopyToSheet.Cells(iCopyToRow, rngTitle_CopyTo.Column)
    
53.                                     End If
    
54.                                 End If
    
55.                             Next
    
56.                             Exit For
    
57.                         ElseIf iCopyRow_End - iCopyRow_Start > 0 Then
    
58.                             '/ copy to output template Sheet
    
59.                             For iLoopTitle = 0 To UBound(arrTitle_CopyFrom)
    
60.                                 Set rngTitle_CopyTo = myCopyToSheet.Rows("1:1").Find(arrTitle_CopyTo(iLoopTitle), Lookat:=xlWhole)
    
61.                                 If Not rngTitle_CopyTo Is Nothing Then
    
62.                                     Set rngTitle_CopyFrom = .Rows(iCopyRow_Start - 1).Find(arrTitle_CopyFrom(iLoopTitle), Lookat:=xlWhole)
    
63.                                     If Not rngTitle_CopyFrom Is Nothing Then
    
64.                                         .Range(.Cells(iCopyRow_Start, rngTitle_CopyFrom.Column), .Cells(iCopyRow_End, rngTitle_CopyFrom.Column)).Copy myCopyToSheet.Cells(iCopyToRow, rngTitle_CopyTo.Column)
    
65.                                     End If
    
66.                                 End If
    
67.                             Next
    
68.                             Exit For
    
69.                         End If
    
70.                     End If
    
71.                 Next
    
72.             End If
    
73.         Next
    
74.     End With
    
75.     GetData_D365 = True
    
76.     Exit Function
    
77. ErrorHandle:
    
78.     GetData_D365 = False
    
79. End Function

复制代码