Transfer Data based off a criteria to certain Column

[ItalianPlatinum]

I need some help to transfer my data to specific columns on my destination sheet. The ability to modify it if it changes I have a line of code that transfers based off a criteria but now to specific columns adds a bit of complexity for me. See for example the below.

Out of memory Run-time 7 Transferring data

I am running into a runtime error trying to transfer data using VBA I used before so I know it works. But when facing a larger data set it is kicking out the below. is there any root cause / solution I can entertain? If Application.WorksheetFunction.CountIf(rng, ">1") > 0 Then 'transfer...

www.mrexcel.com

Source data - the amount of rows may change but always starts on row 11:

Book2
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1
2
3
4
5
6
7
8
9
10
11	Concatenate	Date	Account	Indicator	Group	Currency	Price	Unit Holders	Value	Factor	Average	Total Assets	Total Liabilities	Rate 1	Rate 1 %	Rate 2	Rate 2 %
12	AAAF	1/10/2025	AAA	F	1	USD	$10	1000	$100	0.0001	$10	100	$50	0.005	10%	0.095	90%
Source

Destination - With a header starts on row 2. Should look like this:

Book2
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R
1	Date	Main Account	Unique ID	Indicator	Main Account Group	Currency	Price	Unit Holders	Value	Factor	Pre Price	Average	Total Assets	Total Liabilities	Rate 1	Rate 1 %	Rate 2	Rate 2 %
2		AAA		F	1	USD	10	1000	100	0.0001		10	100	50	0.005	0.1	0.095	0.9
3
Destination

The data must transfer based off the criteria in column D = F. As there will also be other indicators of AZ on it that I do not want to bring over. Thanks in advance - any help is always appreciated. This is a mockup by actual data is over 300 rows if it matters.

 

[Fuji]

Different method without loop.

Sub test()
    Dim x, cols
    cols = "2,3,#,4,5,6,7,8,9,10,#,"
    With Sheets("source")
        With .Rows("11:" & .Cells.SpecialCells(11).Row + 1).Resize(, _
                .Cells(11, Columns.Count).End(xlToLeft)(1, 2).Column)
            cols = Replace(cols, "#", .Columns.Count) & Join( _
                Application.Sequence(1, .Columns.Count - 10, 11, 1), ",")
            x = Application.Index(.Value, Evaluate("row(2:" & .Rows.Count & ")"), Split(cols, ","))
        End With
    End With
    With Sheets("destination").[a1].CurrentRegion
        .Offset(1).ClearContents
        .Rows(2).Resize(UBound(x)) = x
    End With
End Sub

 

[ItalianPlatinum]

Different method without loop.

Sub test()
    Dim x, cols
    cols = "2,3,#,4,5,6,7,8,9,10,#,"
    With Sheets("source")
        With .Rows("11:" & .Cells.SpecialCells(11).Row + 1).Resize(, _
                .Cells(11, Columns.Count).End(xlToLeft)(1, 2).Column)
            cols = Replace(cols, "#", .Columns.Count) & Join( _
                Application.Sequence(1, .Columns.Count - 10, 11, 1), ",")
            x = Application.Index(.Value, Evaluate("row(2:" & .Rows.Count & ")"), Split(cols, ","))
        End With
    End With
    With Sheets("destination").[a1].CurrentRegion
        .Offset(1).ClearContents
        .Rows(2).Resize(UBound(x)) = x
    End With
End Sub

Seems cleaner but doesn't seem to be working is it missing the indicator must equal F or Blank (I added that modification myself later on Dantes code)?