Copy paste using loop from multiple ranges to single row into another WB - excel

Question

I am trying to copy data from multiple source files into a destination file.
So a folder has all the source files I receive.
I now have to collate the data from the files received into a single workbook.
Source file
Destination file/Collation file
I am trying to get some help in collating from each source file in the folder into the destination file.
Sub Transfer_data()
Dim wb As String
Dim i As Long
Dim j As Long
Dim lr As Long
Application.ScreenUpdating = False
i = 0
j = 0
wb = Dir(ThisWorkbook.Path & "\*")
Do Until wb = ""
If wb <> ThisWorkbook.Name Then
Workbooks.Open ThisWorkbook.Path & "\" & wb
With Workbooks(wb).Sheets("D. P & c data")
For i = 21 To 26
For j = 3 To 60 Step 10
.Range(Cells(i, 3), Cells(i, 12)).Copy ThisWorkbook.Sheets("P and c data").Cells(Rows.Count, j).End(xlUp).Offset(1)
Next j
Next i
End With
Application.CutCopyMode = False
Workbooks(wb).Close True
End If
wb = Dir
Loop
Application.ScreenUpdating = True
MsgBox " Copy Complete"
End Sub

Answer 1

I am unsure of what is going on in your code before and after the loop. I think the below loop is what you are looking for. Putting rows outside of columns is easier.
For i = 21 To 26
For j = 3 To 13
Dim lr As Long
lr = ThisWorkbook.Sheets("P and c data").Range("C" & Rows.Count).End(xlUp).Row + 1
Cells(i, j).Copy
Sheets("P and c data").Cells(lr, 3).PasteSpecial
Next j
Next i

Answer 2

Copy Range by Row to Single Row
Option Explicit
' Copies values from a specified range (srcAddr)
' in a specified worksheet (srcID) in all workbooks ("*.xls*") in the folder
' of ThisWorkbook (ThisWorkbook excluded), to a specified worksheet (tgtID)
' in ThisWorkbook. The values of the range are copied into a single row
' starting from a specified column (tgtCol), each row of the range next
' to the previous.
Sub transferData()
Const srcID As Variant = "D. P & c data" ' Name or Index e.g. "Sheet1" or 1
Const srcAddr As String = "C21:L26"
Const tgtID As Variant = "P and c data" ' Name or Index e.g. "Sheet1" or 1
Const tgtCol As Variant = 3 ' Number or String e.g. 1 or "A"
Const Pattern As String = "*.xls*"
Dim wbPath As String: wbPath = ThisWorkbook.Path & Application.PathSeparator
Dim tgt As Worksheet: Set tgt = ThisWorkbook.Worksheets(tgtID)
Application.ScreenUpdating = False
Dim wb As Workbook, src As Worksheet, tgtCell As Range ' Objects
Dim Source As Variant, Target As Variant ' Arrays
Dim i As Long, j As Long, l As Long, Count As Long ' Counters (Longs)
Dim wbname As String: wbname = Dir(wbPath & Pattern)
Do Until wbname = ""
If wbname <> ThisWorkbook.Name Then
GoSub readSource
GoSub writeSource
GoSub writeTarget
End If
WorksheetNotFound:
wbname = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Copied data from " & Count & " workbook(s) containing " _
& "a worksheet ID-ed with '" & srcID & "'.", _
vbInformation, "Data Transfer"
Exit Sub
readSource:
' Write values from Source Range to Source Array.
On Error Resume Next
Set src = Workbooks.Open(wbPath & wbname).Worksheets(srcID)
If Err.Number <> 0 Then GoTo closeSourceError
On Error GoTo 0
Source = src.Range(srcAddr).Value
' Uncomment the following line to write the names of the worksheets
' and the workbooks (that were read from) to the Immediate window (CTRL+G).
Debug.Print src.Name, src.Parent.Name
src.Parent.Close False ' Just reading, no need to save.
Return
writeSource:
' Write values from Source Array to Target Array.
ReDim Target(1 To 1, 1 To UBound(Source) * UBound(Source, 2))
l = 0
For i = 1 To UBound(Source)
For j = 1 To UBound(Source, 2)
l = l + 1
Target(1, l) = Source(i, j)
Next j
Next i
Return
writeTarget:
' Write values from Target Array to Target Range.
Set tgtCell = tgt.Cells(tgt.Rows.Count, tgtCol).End(xlUp).Offset(1)
tgtCell.Resize(, UBound(Target, 2)).Value = Target
Count = Count + 1
Return
closeSourceError:
src.Parent.Close False ' Just reading, no need to save.
On Error GoTo 0
GoTo WorksheetNotFound
End Sub