copy-Paste a range data as many time as there are headers name starting with "X" - excel

Question

I've been trying to find a solution for that problem but nothing came up.
Here is the problem I've got. I would like to copy a variable data range from a sheet called ("Amounts") starting in range "C3" to an other sheet called ("Pasted Amounts") in range F2 as many time as columns, in sheets "Amounts" are starting with the following value " Amounts in USD".
I've been coding something but it doesn't work... I put a counter in a cell to count how many time there are columns starting with the value " Amounts in USD" in order to pick the value appearing in that cell and repeat the paste process. But I've been complicated the code I guess...
Here is my code;
Dim cel2 As Range
Dim counter as Integer
With Sheets("Amounts")
Worksheets("Amounts").Activate
For Each cel2 In Range("A2", Range("A2").End(xlToRight))
If cel2.Value Like "Amount in USD*" Then
counter = counter + 1
Range("U4").Value = counter
End If
With Worksheets("Pasted Amounts").Activate
'~Here is bellow the column named " clients name" I want to paste in "Pasted amounts" sheet (by coping it in the sheet "Amounts"
worksheets("Amounts").Range("C3",range("C3").end(xldown).Select
'~ Paste the range copied in sheet " Pasted Amount" as many time the counter value is
.Copy Range("F2").Resize(.Count * counter)
End With
Next cel2
End With
End sub
Once again, I'd appreciate so much your help...
Mido88

Answer 1

Sub test()
Dim LastColumn As Long, LastRow As Long, counter as Long
With Sheets("Amounts")
LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
counter = WorksheetFunction.CountIf(.Range("A1", .Cells(1, LastColumn)), "Amount in USD*")
.Range("C3:C" & LastRow).Copy _
Worksheets("Pasted Amounts").Range("F2").Resize(.Range("C3:C" & LastRow).Count * counter)
End With
End Sub
Or as a silly long one line of code:
Sub test()
Sheets("Amounts").Range("C3:C" & Sheets("Amounts").Cells(Sheets("Amounts").Rows.Count, "C").End(xlUp).Row).Copy Worksheets("Pasted Amounts").Range("F2").Resize(Sheets("Amounts").Range("C3:C" & Sheets("Amounts").Cells(Sheets("Amounts").Rows.Count, "C").End(xlUp).Row).Count * WorksheetFunction.CountIf(Sheets("Amounts").Range("A1", Sheets("Amounts").Cells(1, Sheets("Amounts").Cells(1, Sheets("Amounts").Columns.Count).End(xlToLeft).Column)), "Amount in USD*"))
End Sub

Answer 2

Alright I found the solution!
Thank you again Siddharth and Christofer, your answers helped me a lot to think further...
Here is the solution that worked really well! I used the answer in the previous post I made here:link and added a single line code to paste as many time the range of datas as" Amounts in USD " was found in the previous sheet.
Sorry again for those misunderstandings. I hope that my answer would help you and the other users in need!
Here it is;
Sub Sample()
Dim wsInput As Worksheet
Dim wsOutput As Worksheet
Dim lRowInput As Long
Dim lRowOutput As Long
Dim lCol As Long
Dim i As Long
Dim Col As String
'~~> Set your sheets here
Set wsInput = Sheets("Amounts")
Set wsOutput = Sheets("Pasted Amounts")
With wsInput
'~~> Find last column in Row 2
lCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
'~~> Loop through columns
For i = 1 To lCol
'~~> Check for your criteria
If .Cells(2, i).Value2 Like "Amount in functional currency*" Then
'~~> Get column name
Col = Split(.Cells(, i).Address, "$")(1)
'~~> Get the last row in that column
lRowInput = .Range(Col & .Rows.Count).End(xlUp).Row
'~~> Find the next row to write to
If lRowOutput = 0 Then
lRowOutput = 2
Else
lRowOutput = wsOutput.Range("A" & wsOutput.Rows.Count).End(xlUp).Row + 1
End If
'~~> Copy the datas ( for each column where Amounts in USD was found)
.Range(Col & "3:" & Col & lRowInput).Copy _
wsOutput.Range("A" & lRowOutput)
~~> SOLUTION BELLOW-Copy the variable data range ("C3")
Worksheets("Amounts").Activate
.Range("C3", Range("C3").End(xlDown)).Copy wsOutput.Range("F" & lRowOutput)
End If
Next i
End With
End Sub
Mido