Appendix Thread. App Index Rws() Clms() Majic code line Codings for other Threads, Tables etc.)

In support of this post

Source Workbook

_____ Workbook: Transfer data_marasAlan_3.xlsm ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI
1	Number	Unique ID	Name	Title	Platform	Filter					Salary				Add1	Add2	Add3	Add4	Add5	Add6	Add7	Add8	Add9	Add10	Add11	Add12	copy1	copy2	copy3	copy4	copy5	copy6	copy7	Total	grandtotal
4	3	3658	Lalu	Lead	C	Filter2					£300					6	6		6		6								1	1	2			4	£1,200
9	2	563	Vidu	Manager	Java	Filter2					£400																		8	12				20	£8,000
10	2	563	Vidu	Manager	Java	Filter2					£425																		8	12				20	£8,500
12	2	563	Vidu	Manager	Java	Filter2					£400																		8	13				21	£8,400
16	2	354	Sai	Operator	C++	Filter2					£150							23			2								24					24	£3,600
17	2	333	Fran	Operator	SQL	Filter2					£150						1									1									£0
18	3	239	Jack	Lead	SQL	Filter2					£566											45					4	4		8	4			20	£11,320
19	3	239	Jack	Lead	SQL	Filter2					£300											46					4	4	4	8	4			24	£7,200
23	4	222	Andy	Operator	Java	Filter2					£150																	4			14	8		26	£3,900
24	1	123	Ram	Manager	Java	Filter2					£400						3							55			12					3		15
36	1	26	Som	Operator	C	Filter2					£150

Worksheet: Sheet1


https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=tzbKqTRuRzU&lc=UgyYW2WZ2DvSrzUKnJ14AaABAg
https://www.youtube.com/watch?v=UywjKEMjSp0&lc=UgxIySxHPqM1RxtVqoR4AaABAg. 9edGvmwOLq99eekDyfS0CD
https://www.youtube.com/watch?v=UywjKEMjSp0&lc=UgxIySxHPqM1RxtVqoR4AaABAg. 9edGvmwOLq99eevG7txd2c
https://www.youtube.com/watch?v=SIDLFRkUEIo&lc=UgzTF5vvB67Zbfs9qvx4AaABAg
https://www.youtube.com/watch?v=9P6r7DLS77Q&lc=UgzytUUVRyw9U55-6M54AaABAg
https://www.youtube.com/watch?v=9P6r7DLS77Q&lc=UgzCoa6tOVIBxRDDDbN4AaABAg
https://www.youtube.com/watch?v=9P6r7DLS77Q&lc=UgyriWOelbVnw4FHWT54AaABAg. 9dPo-OdLmZ09dc21kigjmr
https://www.youtube.com/watch?v=363wd2EtQZ0&lc=UgzDQfo5rJqyVwvv2r54AaABAg
https://www.youtube.com/watch?v=363wd2EtQZ0&lc=UgzHTSka7YppBdmUooV4AaABAg. 9cXui6zzkz09cZttH_-2Gf
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

In support of this post






Before destination

_____ Workbook: Workbook2_3.xlsx ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1		Unique ID	Gap	Name	Title	Platform	Salary	Gap	Total	copy1	copy2	copy3	copy4	copy5	copy6	copy7
2

Worksheet: Sheet1

After Destination

_____ Workbook: Workbook2_3.xlsx ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S
1		Unique ID	Gap	Name	Title	Platform	Salary	Gap	Total	copy1	copy2	copy3	copy4	copy5	copy6	copy7
2		3658		Lalu	Lead	C	£300		24	4			1	1	2
3		563		Vidu	Manager	Java	£425		0	20			8	12
4		354		Sai	Operator	C++	£150		25	24			24
5		333		Fran	Operator	SQL	£150		2
6		239		Jack	Lead	SQL	£566		45	20	4	4		8	4
7		222		Andy	Operator	Java	£150		0	26		4			14	8
8		123		Ram	Manager	Java	£400		58	15	12					3
9		26		Som	Operator	C	£150		0
10

Worksheet: Sheet1

macro for last two posts

Code:

---

Option Explicit
Sub Transfer_marasAlan_3()  '  https://www.excelforum.com/excel-programming-vba-macros/1338596-transferring-data.html#post5460624
Dim a(), cls_v() As String, Rws(), aSum(), arrOut__(), JagdDikIt()
Dim Rng As Range, Rng_v As Range, cel As Range
Dim Wrbk As Workbook, Rw As Long
Dim Pth As String
 Let Pth = ThisWorkbook.Path & Application.PathSeparator  '      Const pth = "C:\Users\L026936\Desktop\Excel\"      '<---- use own path
Const Wnm = "Workbook2_3.xlsx"                            'your workbook name
'    Application.ScreenUpdating = False
Rem 1 the main data range from source
    With ThisWorkbook.Sheets("Sheet1")
    Set Rng = .Range("a1:ai" & 36 & "")    '  main data range    hard coded to 36  for testing and  demonstration        .UsedRange.Rows.Count)
    Let a() = Rng.Value                    '  all data values in the source.  This will end up in the tyopical    arrOut()=AppIndex( a(), Rws(),  Clms() )
    Set Rng_v = Rng.Columns(2).SpecialCells(xlCellTypeVisible)  '  this gives us the range we see , (it is likely as a collection of areas) in the ID column
        If Rng_v.Count > 1 Then
  Rem 2 Make the sums column array, aSum() , and while we are looping we will collect the seen row indicies, Rws()
'      ' ddddddddddddddddddddddd Dictionaray bit ------
        '  Dictionaray    -  The only reason to use this is that its a convenient way to get a unique list thing, or a unique set of things.
        Dim Dik As Object: Set Dik = CreateObject("Scripting.Dictionary")  '      https://excelmacromastery.com/vba-dictionary/
        'Dim d As Scripting.Dictionary: Set d = New Scripting.Dictionary
        Dim aTp() As Variant: ReDim aTp(1 To 3) ' This is a temporary array used to fill the dictionary  Items  it must be dynamic and variant type  - see note +++ below
            For Each cel In Rng_v  '  we effectivelly are going down all the seen rows
                If cel.Row > 1 And cel.Value <> "" Then
                Let Rw = cel.Row
                    If Not Dik.exists(a(Rw, 2)) Then ' -Case we don't yet have any dictionaray item with this ID  key
                    Let aTp(1) = Rw                                          '  row number
                    Let aTp(2) = a(Rw, 35)                                  '  grangtotal for this row
                    Let aTp(3) = .Evaluate("=Sum(o" & Rw & ": z" & Rw & ")") ' Our  column Sums
                    Dik.Add Key:=a(Rw, 2), Item:=aTp() '  The key becomes the ID  ,      The Item is a three element array of      the row number    the columns sum for this row    the gradtotal for this row                              shothand way to do this line is  d(a(r, 2)) = atp
                    Else '                          ' -Case we already have a dictionary item with this key
                    Let aTp() = Dik.Item(a(Rw, 2)) ' we are returning an item that is an array, so the recieving array variable must be dynamic.  the returned element type3s are  Variant  +++
                        If a(Rw, 35) > aTp(2) Then  '  If the grand total for this row and  ID  is  greater than a previous, then ....
                            Let aTp(1) = Rw                                        '  we are replacing ..
                            Let aTp(2) = a(Rw, 35)                                '    .. the item with the relavent  ..
                            Let aTp(3) = .Evaluate("=Sum(o" & Rw & ": z" & Rw & ")") '    .. info from this row
                            Dik(a(Rw, 2)) = aTp()  '  shorthand version for  Dik.Add  Key:=a(Rw, 2), Item:=aTp()
                        End If
                    End If ' end of making or replacing  a dictiuonary item
                Else
                End If
            Next
        ' at this point we have a dictionary that has one  Item  for each  ID
        ' in this last  Dik  bit we use the first and third part  of the 3 element items  in  a pseudo  arrOut()=AppIndex( arrUnjaggedJaged(), Rws() , Clms() )    '    https://www.ozgrid.com/forum/index.php?thread/1227920-slicing-a-2d-array/&postID=1239241#post1239241
            If Dik.Count Then
                'Let JagdDikIt() = Application.Transpose(Dik.items()) '    we can treat an unjagged jagged array  that is a 1 D array of 1 D arrays as if it was a  2 D array  ...  https://eileenslounge.com/viewtopic.php?p=266691#p266691
                Let JagdDikIt() = Dik.items()
                'Let Rws() = Application.Index(JagdDikIt(), 1, Evaluate("row(1:" & UBound(JagdDikIt(), 2) & ")"))                                          '  Application.Transpose(Application.Transpose(Application.Index(v, 1, Evaluate("row(1:" & UBound(v, 2) & ")"))))
                Let Rws() = Application.Index(JagdDikIt(), Evaluate("row(1:" & UBound(JagdDikIt()) + 1 & ")"), 1)                                        '  Application.Transpose(Application.Transpose(Application.Index(v, 1, Evaluate("row(1:" & UBound(v, 2) & ")"))))
                'Let aSum() = Application.Index(JagdDikIt(), 3, Evaluate("row(1:" & UBound(JagdDikIt(), 2) & ")"))                        'Application.Transpose(Application.Transpose(Application.Index(v, 3, Evaluate("row(1:" & UBound(v, 2) & ")"))))
                Let aSum() = Application.Index(JagdDikIt(), Evaluate("row(1:" & UBound(JagdDikIt()) + 1 & ")"), 3)                      'Application.Transpose(Application.Transpose(Application.Index(v, 3, Evaluate("row(1:" & UBound(v, 2) & ")"))))
'      ' ddddddddddddddddddddddddd -----------------------------
            Else
            End If
        Else ' case only a header row to be seen
        End If
    End With
    If Rng_v.Count = 1 Or Dik.Count = 0 Then
        MsgBox "No rows to transfer."
        Exit Sub
    End If
    On Error Resume Next  '  https://eileenslounge.com/viewtopic.php?f=30&t=35861&start=20
    Set Wrbk = Workbooks(Wnm)
        If Wrbk Is Nothing Then
        Workbooks.Open Filename:=Pth & Wnm
        Else
        Workbooks(Wnm).Activate
        End If
    On Error GoTo 0
    With ActiveWorkbook
        With .Sheets("Sheet1")
        Dim vTemp As Variant ' just for demo purposes
        Let vTemp = .UsedRange.Rows(1)
        ' { empty ,  Unique ID  , Gap ,Name  ,  Title ,  Platform  ,  Salary , Gap, Total ,  copy1  , copy2 ,  copy3 ,  copy4  , copy5 ,  copy6 ,  copy7 ,  copy2 ,  copy3 ,  copy4 ,  copy5  , copy6 ,  copy7 ,  Formula7  , Formula8 ,  Formula9  }
        Let vTemp = Rng.Rows(1)
        ' { Number , ID , Name ,  Title ,  Platform ,  Filter  ,  ,  ,  ,    ,Salary ,  ,    ,  ,Add1  ,  Add2 ,  Add3  ,  Add4  ,  Add5 ,  Add6 ,  Add7  ,  Add8 ,  Add9 ,  Add10 ,  Add11 ,  Add12 ,  copy1 ,  copy2 ,  copy3 ,  copy4 ,  copy5  , copy6 ,  copy7  , Total ,  grandtotal  }
        Let vTemp = Application.Match(.UsedRange.Rows(1), Rng.Rows(1), 0) '  This gives a 1 D array and each element has either the position of the header in the destination workbook, or an error if it did not find it
        '  { 2 ,  error  , 3  , 4 ,  5 ,  11  , error  , 34 ,  27 ,  28 ,  29  , 30 ,  31 ,  32 ,  33 , 28 , error ,error ,error ,error ,error ,error ,error ,error ,error ,  }
        ' So the above line tells us where there is an error in a match with the header names
        Let vTemp = Application.IfError(vTemp, "x") ' Instead of the vbError , a text of  "x"  is put into the array
        '  { 2 ,  x  , 3  , 4 ,  5 ,  11  , x , 34  ,  27 ,  28 ,  29  , 30 ,  31 ,  32 ,  33 , x ,x ,x ,x ,x ,x ,x ,x ,x ,  }
        Let vTemp = Filter(vTemp, "x", False, 0) ' take out the  "x"s
        '  { 2    , 3  , 4 ,  5 ,  11  , 34,  27 ,  28 ,  29  , 30 ,  31 ,  32 ,  33  }
        Let cls_v() = Filter(Application.IfError(Application.Match(.UsedRange.Rows(1), Rng.Rows(1), 0), "x"), "x", False, 0)
        '  { 2  , 3  , 4 ,  5 ,  11  ,  27 ,  28 ,  29  , 30 ,  31 ,  32 ,  33  }
            With .Range("B2")  '  .UsedRange.Offset(1)
            ' .Resize(, 15).ClearContents
            Let arrOut__() = Application.Index(a(), Rws(), cls_v())
            .Resize(UBound(Rws()), 1) = arrOut__()
            Let Rws() = Evaluate("row(1:" & UBound(Rws()) & ")") '  Using the variable  Rws()  for a sequential indicie list  1; 2; 3 ... etc for all rows in the  arrOut__()
            .Offset(, 2).Cells(1).Resize(UBound(Rws()), 4).Value = Application.Index(arrOut__(), Rws(), Array(2, 3, 4, 5))  '  columns  D - G
            .Offset(, 7).Cells(1).Resize(UBound(Rws())) = aSum()  '  columm I
            .Offset(, 8).Cells(1).Resize(UBound(Rws()), 7).Value = Application.Index(arrOut__(), Rws(), Array(6, 7, 8, 9, 10, 11, 12))  ' Column J to P
            End With
        End With
'        .Save
    End With
'    Set Rng = Nothing
'    Set Rng_v = Nothing
'    Set cel = Nothing
    Set Dik = Nothing
End Sub

---

ycb<ybc,bc,ybcybyb

In support of this posting
https://eileenslounge.com/viewtopic....280747#p280747

befores
_____ Workbook: Workbook2_2b.xlsx ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA
1		Unique ID	Gap	Name	Title	Platform	Salary	Gap	Total	copy1	copy2	copy3	copy4	copy5	copy6	copy7	From SHEET2	Salary	Total	copy1	copy2	copy3	copy4	copy5	copy6	copy7
2
3
4
5
6
7
8
9
10
11

Worksheet: Destination

In support of this posting
https://eileenslounge.com/viewtopic....280747#p280747


_____ Workbook: Transfer data_marasAlan_2b.xlsm ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG
1	Number	Unique ID	Name	Title	Platform	Filter					Salary				Add1	Add2	Add3	Add4	Add5	Add6	Add7	Add8	Add9	Add10	Add11	Add12	copy1	copy2	copy3	copy4	copy5	copy6	copy7
2	1	123	Ram	Manager	Java	Filter2					£400						3							55			12					3	222
9	1	26	Som	Operator	C	Filter2					£150																						1,013
10	2	354	Sai	Operator	C++	Filter2					£150							23			2								24				1,126
17	2	563	Vidu	Manager	Java	Filter2					£400																		8	12			147
18	3	239	Jack	Lead	SQL	Filter2					£300											45					4	4		8	4		149
19	4	222	Andy	Operator	Java	Filter2					£150																	4			14	8	151
24	2	333	Fran	Operator	SQL	Filter2					£150						1									1							161
25	3	3658	Lalu	Lead	C	Filter2					£300					6	6		6		6								1	1	2		163

Worksheet: Sheet1

In support of this posting
https://eileenslounge.com/viewtopic....280747#p280747

The after


_____ Workbook: Workbook2_2b.xlsx ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA
1		Unique ID	Gap	Name	Title	Platform	Salary	Gap	Total	copy1	copy2	copy3	copy4	copy5	copy6	copy7	From SHEET2	Salary	Total	copy1	copy2	copy3	copy4	copy5	copy6	copy7
2		123		Ram	Manager	Java	£400		58	12					3	222
3		26		Som	Operator	C	£150		0							1,013
4		354		Sai	Operator	C++	£150		25			24				1,126
5		563		Vidu	Manager	Java	£400		0			8	12			147
6		239		Jack	Lead	SQL	£300		45	4	4		8	4		149
7		222		Andy	Operator	Java	£150		0		4			14	8	151
8		333		Fran	Operator	SQL	£150		2							161
9		3658		Lalu	Lead	C	£300		24			1	1	2		163
10
11

Worksheet: Destination

Macro for last 3 posts

Code:

---

Option Explicit
Sub Transfer_Sht1After() '  https://eileenslounge.com/viewtopic.php?p=280747#p280747
Rem 1 Source Worksheets info
Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets.Item(1)
Dim Lr1 As Long: Let Lr1 = Ws1.Range("B" & Ws1.Rows.Count & "").End(xlUp).Row
'1b)  Any column in the visible data is taken in the next code line, the main reason being as we need to get the row indicie info
Dim Rng_v As Range: Set Rng_v = Ws1.Range("B1:B" & Lr1 & "").SpecialCells(xlCellTypeVisible) ' this gets just the range we see, so will be likely a range of lots of areas
    If Rng_v.Count = 1 Then ' case only header range visible
    MsgBox Prompt:="No rows to transfer.": Exit Sub
    Else ' there are visible rows to transfer
    Rem 2 building a single column array for the summed colums, and the wanted visible row indicies from the main range
    Dim aSum() As Variant: ReDim aSum(1 To Rng_v.Count - 1, 1 To 1) '  This will be a  column  array when applied to a worksheet
    Dim Rws() As Long: ReDim Rws(1 To Rng_v.Count - 1, 1 To 1) ' we need a  "virtical"  array containing the "seen" row indicies
    Dim Cel As Range
        For Each Cel In Rng_v '  These are the cells in the multi  Area  range of visible cells
            If Cel.Row > 1 And Cel.Value <> "" Then
            Dim I As Long
            Let I = I + 1
            Let aSum(I, 1) = Evaluate("=Sum('[" & ThisWorkbook.Name & "]Sheet1'!O" & Cel.Row & ":'[" & ThisWorkbook.Name & "]Sheet1'!Z" & Cel.Row & ")")
            Let Rws(I, 1) = Cel.Row '  This  puts the visible rows indicie in our array indicationg the rows we need from the worksheet
            Else
            End If
        Next Cel
    End If
' Destination workbook and worksheet
Dim Pth As String: Let Pth = ThisWorkbook.Path & Application.PathSeparator '  Const Pth = "C:\Users\L026936\Desktop\Excel\"      '<---- use own path
Const Wnm = "Workbook2_2b.xlsx"              'your destination workbook2  name
On Error Resume Next                                    '    https://eileenslounge.com/viewtopic.php?f=30&t=35861&start=20
Dim WbDest As Workbook
 Set WbDest = Workbooks(Wnm) ' will error if workbook is not yet open
    If Err.Number > 0 Then
    Workbooks.Open Filename:=Pth & Wnm ' we test to see if we have an error and if we do themn we kknow to open the workbook    On Error GoTo 0
    Set WbDest = ActiveWorkbook
    Else
    End If
''2a) Column indicies of the columns wanted from the data worksheet
Dim Clms() As Variant: Let Clms() = Array(2, 34, 3, 4, 5, 11, 34, 34, 27, 28, 29, 30, 31, 32, 33)
'2b) Typical arrOut()=AppIndex(arrIn(), Rws(), Clms())
 Let WbDest.Worksheets.Item(1).Range("B2").Resize(UBound(Rws(), 1), 15).Value2 = Application.Index(Ws1.Cells, Rws(), Clms())
'2c)(ii) Sums column
 Let WbDest.Worksheets.Item(1).Range("B2").Resize(UBound(Rws(), 1), 1).Offset(0, 7).Value2 = aSum()
End Sub

---

Links relavent to the last 9 posts

Code:

---

' https://www.excelforum.com/excel-programming-vba-macros/1338596-transferring-data.html#post5458446
' _  First i wanted to filter column G from workbook 1 to "Filter 2" and transfer only filter 2 data to workbook 2.
' _  Then transferring like i wanted to transfer column C (source) to column B (destination) , column D to D, Column L to Column G, etc.
' _  I wanted to sum from column P to colum AA and transfer those sum to destination at column H
' _ Then copy from column AB to AH and paste in I to O in destination

Sub Transfer_maras_1()

---

Here is a before and after…
https://excelfox.com/forum/showthrea...ll=1#post15278
https://excelfox.com/forum/showthrea...ll=1#post15279

Macro
https://excelfox.com/forum/showthrea...ll=1#post15277

Files
Transfer data_marasAlan_1.xlsm : https://app.box.com/s/p8kf5vo8jesql3n47sd1bzgm57qdpwdv
Workbook2_1.xlsx : https://app.box.com/s/3d9gmeb2nlyr4gg9q802kk5mjgze8cl5





_.________________________________________________ _________________________________________________

Code:

---

Sub Transfer_marasAlan_2() '

---

Here is a before and after…
https://excelfox.com/forum/showthrea...ll=1#post15276
https://excelfox.com/forum/showthrea...ll=1#post15273


Macro
https://excelfox.com/forum/showthrea...ll=1#post15272

Files
Transfer data_marasAlan_2.xlsm : https://app.box.com/s/749a78z2ku4m1s1tg3fvgs1z1ud4s325
Workbook2_2.xlsx : https://app.box.com/s/13yh30a77spsluauck3nif309pic8fuz
















_.___________________________________________

Code:

---

Sub Transfer_marasAlan_3()  '  https://www.excelforum.com/excel-programming-vba-macros/1338596-transferring-data.html#post5460624

---

Here is a before and after…
https://excelfox.com/forum/showthrea...ll=1#post15269
https://excelfox.com/forum/showthrea...ll=1#post15270

Macro
https://excelfox.com/forum/showthrea...ge42#post15271

Files
https://excelfox.com/forum/showthrea...ge42#post15233
Transfer data_marasAlan_3.xlsm : https://app.box.com/s/p8kf5vo8jesql3n47sd1bzgm57qdpwdv
Workbook2_3.xlsx : https://app.box.com/s/y3rwvhfk3bo1rp9t7cgbk8yz3krymh23

Links relavent to the last 9 posts

Code:

---

' https://www.excelforum.com/excel-programming-vba-macros/1338596-transferring-data.html#post5458446
' _  First i wanted to filter column G from workbook 1 to "Filter 2" and transfer only filter 2 data to workbook 2.
' _  Then transferring like i wanted to transfer column C (source) to column B (destination) , column D to D, Column L to Column G, etc.
' _  I wanted to sum from column P to colum AA and transfer those sum to destination at column H
' _ Then copy from column AB to AH and paste in I to O in destination

Sub Transfer_maras_1()

---

Here is a before and after…
https://excelfox.com/forum/showthrea...ll=1#post15278
https://excelfox.com/forum/showthrea...ll=1#post15279

Macro
https://excelfox.com/forum/showthrea...ll=1#post15277

Files
Transfer data_marasAlan_1.xlsm : https://app.box.com/s/p8kf5vo8jesql3n47sd1bzgm57qdpwdv
Workbook2_1.xlsx : https://app.box.com/s/3d9gmeb2nlyr4gg9q802kk5mjgze8cl5





_.________________________________________________ _________________________________________________

Code:

---

Sub Transfer_marasAlan_2() '

---

Here is a before and after…
https://excelfox.com/forum/showthrea...ll=1#post15276
https://excelfox.com/forum/showthrea...ll=1#post15273


Macro
https://excelfox.com/forum/showthrea...ll=1#post15272

Files
Transfer data_marasAlan_2.xlsm : https://app.box.com/s/749a78z2ku4m1s1tg3fvgs1z1ud4s325
Workbook2_2.xlsx : https://app.box.com/s/13yh30a77spsluauck3nif309pic8fuz
















_.___________________________________________

Code:

---

Sub Transfer_marasAlan_3()  '  https://www.excelforum.com/excel-programming-vba-macros/1338596-transferring-data.html#post5460624

---

Here is a before and after…
https://excelfox.com/forum/showthrea...ll=1#post15269
https://excelfox.com/forum/showthrea...ll=1#post15270

Macro
https://excelfox.com/forum/showthrea...ge42#post15271

Files
https://excelfox.com/forum/showthrea...ge42#post15233
Transfer data_marasAlan_3.xlsm : https://app.box.com/s/p8kf5vo8jesql3n47sd1bzgm57qdpwdv
Workbook2_3.xlsx : https://app.box.com/s/y3rwvhfk3bo1rp9t7cgbk8yz3krymh23