create excel files on excel data

[m_vishal_c]

hi I have 2 Excel files. 1 Source and 2nd Destination. There are some columns in Source file like
[TABLE="width: 403"]
<tbody>[TR]
[TD]Sr No[/TD]
[TD]Name[/TD]
[TD]Address[/TD]
[TD]Contact no[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Abc[/TD]
[TD]xxxx[/TD]
[TD]123[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Xyz[/TD]
[TD]xxxx[/TD]
[TD]345[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Mno[/TD]
[TD]xxxx[/TD]
[TD]567[/TD]
[/TR]
</tbody>[/TABLE]
and in Destination there are below fields
[TABLE="width: 75"]
<tbody>[TR]
[TD][TABLE="width: 98"]
<tbody>[TR]
[TD]A1 Sr No[/TD]
[/TR]
[TR]
[TD]A2 Name[/TD]
[/TR]
[TR]
[TD]A3 Address[/TD]
[/TR]
[TR]
[TD]A4 Contact NO[/TD]
[/TR]
[TR]
[TD]A5 and other stuff[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
I need vba code which create new excel file on each row and copy relevant information and save as Name data

if anyone can help then it will be great.
Heaps thanks in advance

 

[m_vishal_c]

So you already have: Two workbooks. You said:
"hi I have 2 Excel files. 1 Source and 2nd Destination. There are some columns in Source file like"
We need the full exact names of these two Workbooks and what the sheet names are in each of these workbooks.

I believe your going to Email out these files you want to create.
Why can we not create a new sheet for each row and not a new workbook?

If you have 500 rows then you want 500 new Workbooks doing things the way you seem to want.

Thanks mate. but I need to create Workbooks not excel sheet. and I am not going to send email those Workbooks.

 

[JackDanIce]

Let's see if this can get you started, you may need to change some of the values:

Sub CreateFiles()

    Dim arr()   As Variant
    Dim x       As Long
    Dim wkb     As Workbook
    Dim strPath As String
    
    'Folder to save output files to
    strPath = ThisWorkbook.path & "\"
    
    With Workbooks("Source").Sheets(1)
        x = .Cells(.Rows.count, 1).End(xlUp).row - 1
        'Assumes row 1 has headers so start with A2
        arr = .Cells(2, 1).Resize(x, 5).Value
    End With
    
    Application.ScreenUpdating = False
    
    For x = LBound(arr, 1) To UBound(arr, 1)
        Set wkb = Workbooks.add(1)
        With wkb
            With .Sheets(1)
                .Cells(2, 1).Resize(UBound(arr, 2)) = Application.Transpose(Application.Index(arr, 1, 0))
                'Sheet name  
                .Name = arr(x, 1)
            End With
            'File name
            .SaveAs strPath & arr(x, 1) & ".csv", FileFormat:=xlCSV
            .Close False
        End With
        Set wkb = Nothing
    Next x

    Application.ScreenUpdating = True
    
    Erase arr
    
End Sub

As this is for Mail Merge, you can probably use single sheet CSV files (smaller size, faster to open) to save output to.

In the code, you may need to change the folder the files are saved to

 

[m_vishal_c]

Let's see if this can get you started, you may need to change some of the values:

Sub CreateFiles()

    Dim arr()   As Variant
    Dim x       As Long
    Dim wkb     As Workbook
    Dim strPath As String
    
    'Folder to save output files to
    strPath = ThisWorkbook.path & "\"
    
    With Workbooks("Source").Sheets(1)
        x = .Cells(.Rows.count, 1).End(xlUp).row - 1
        'Assumes row 1 has headers so start with A2
        arr = .Cells(2, 1).Resize(x, 5).Value
    End With
    
    Application.ScreenUpdating = False
    
    For x = LBound(arr, 1) To UBound(arr, 1)
        Set wkb = Workbooks.add(1)
        With wkb
            With .Sheets(1)
                .Cells(2, 1).Resize(UBound(arr, 2)) = Application.Transpose(Application.Index(arr, 1, 0))
                'Sheet name  
                .Name = arr(x, 1)
            End With
            'File name
            .SaveAs strPath & arr(x, 1) & ".csv", FileFormat:=xlCSV
            .Close False
        End With
        Set wkb = Nothing
    Next x

    Application.ScreenUpdating = True
    
    Erase arr
    
End Sub

As this is for Mail Merge, you can probably use single sheet CSV files (smaller size, faster to open) to save output to.

In the code, you may need to change the folder the files are saved to

Hi Thanks for reply and sorry for late reply. I tried this code but it gives me this error " A File named 'path.csv' already exits in this location. do you want to replace it ? and if I click no then it gives me another error " Run time error '1004'; Method 'SaveAs of object'_Workbook' Failed

Please guide me. thanks

 

[m_vishal_c]

Hi Thanks for reply and sorry for late reply. I tried this code but it gives me this error " A File named 'path.csv' already exits in this location. do you want to replace it ? and if I click no then it gives me another error " Run time error '1004'; Method 'SaveAs of object'_Workbook' Failed

Please guide me. thanks

hi Please ignore above error. I fixed it. but this line

" .Cells(2, 1).Resize(UBound(arr, 2)) = Application.Transpose(Application.Index(arr, 1, 0)) "

paste same value in each file. but save as new name . that's fine but there is same value in each file. must be different value as per source file.

please sort it out . heaps thanks

 

[JackDanIce]

Change

Index(arr, 1, 0)

to

Index(arr, x, 0)