Copy data from 1 row to other Sheet

[o0omax]

Hi,

I have one list with 100 rows, where each row is 1 project. (see attachment)

Now for each row of that Excel I want to have a new Excel File where the data is in the canvas (see attachment). Instead of copying it by hand. How can I do this automated?

Greetings

[anish.ms]

May be, just a try from my side
Files will be saved on your desktop

Save the code in workbook "Excel Express - Data"


Sub copydata()
Dim Data As Worksheet
Dim Canvas As Worksheet
Dim rowLast As Long
Dim i As Long
Dim Filename As String
Set Data = ThisWorkbook.Sheets("Tabelle1")
Set Canvas = Workbooks("Excel Express - canvas.xlsx").Sheets("PowerQuery")
rowLast = Data.Cells(Rows.Count, "F").End(xlUp).Row

With Application
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With

'On Error Resume Next
MkDir Environ("USERPROFILE") & "\Desktop\Canvas"
'On Error GoTo 0

For i = 5 To rowLast
With Canvas
.Range("A5:DR5").Value = Data.Range("A" & i & ":DR" & i).Value
Filename = .Range("F5").Value
.SaveAs Environ("USERPROFILE") & "\Desktop\Canvas\" & Filename & ".xlsx"
End With
Next i

With Application
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
MsgBox "Completed!", vbInformation
End Sub