Save records from one file into seperate other files.

[Boss]

I have one master file with five fields

Field1 Field2 Field3 Field4 Filename
-- -- -- -- --
-- -- -- -- --
-- -- -- -- --
-- -- -- -- --
-- -- -- -- --

I need to create one excel file per record.

I need to paste A2 data into new file A2 cell, B2 data into new file B2 cell
and finally want to save the new file with filaname which is in E2

I need to repeat the entire process for each record.

As the output required is in excel i cannot use mailmerge. I tried to record
a macro and then put a loop but failed.

Please help me to solve this.

Thanks a lot in advance..
Boss

 

[Otto Moehrbach]

Boss
This macro will do that for you. I assumed a path to the destination
folder of:
C:\My Folder
Change this as needed. HTH Otto
Sub CreateFiles()
Dim FileName As String
Dim rColA As Range
Dim i As Range
Dim FullPath As String
Set rColA = Range("A2", Range("A" & Rows.Count).End(xlUp))
Application.ScreenUpdating = False
For Each i In rColA
FileName = i.Offset(, 4).Value
FullPath = "C:\My Folder\" & FileName & ".xls"
Workbooks.Add
i.Resize(, 4).Copy Range("A2")
ActiveWorkbook.SaveAs FileName:=FullPath
ActiveWorkbook.Close
Next i
Application.ScreenUpdating = True
End Sub

 

[Boss]

This was HEAVEN...

Thanks a lot.. !!
Boss

Boss
This macro will do that for you. I assumed a path to the destination
folder of:
C:\My Folder
Change this as needed. HTH Otto
Sub CreateFiles()
Dim FileName As String
Dim rColA As Range
Dim i As Range
Dim FullPath As String
Set rColA = Range("A2", Range("A" & Rows.Count).End(xlUp))
Application.ScreenUpdating = False
For Each i In rColA
FileName = i.Offset(, 4).Value
FullPath = "C:\My Folder\" & FileName & ".xls"
Workbooks.Add
i.Resize(, 4).Copy Range("A2")
ActiveWorkbook.SaveAs FileName:=FullPath
ActiveWorkbook.Close
Next i
Application.ScreenUpdating = True
End Sub

 

[Boss]

If i need to copy Master sheet A2 cell to new sheet d5 and B2 to d11 and C2
to d12, how can i do that.

I am really sorry but i just noticed that one of my team member requires in
it in other way.

Please help me solve this.

Thanks!
Boss

 

[Otto Moehrbach]

Boss
Here is the new macro. Notice the "Select Case" construct. That is
where the code finds the address of the destination cell. When the
destination cells were contiguous I was able to paste the 4 cells at one
time. This time the code has to work with the source cells one at a time.
HTH Otto
Sub CreateFiles2()
Dim FileName As String
Dim rColA As Range
Dim i As Range
Dim j As Range
Dim FullPath As String
Dim CellAddress As String
Set rColA = Range("A2", Range("A" & Rows.Count).End(xlUp))
Application.ScreenUpdating = False
For Each i In rColA
FileName = i.Offset(, 4).Value
FullPath = "C:\My Folder\" & FileName & ".xls"
Workbooks.Add
For Each j In i.Resize(, 4)
Select Case j.Column
Case 1: CellAddress = "D5"
Case 2: CellAddress = "D11"
Case 3: CellAddress = "D12"
Case 4: CellAddress = "D13"
End Select
j.Copy Range(CellAddress)
Next j
ActiveWorkbook.SaveAs FileName:=FullPath
ActiveWorkbook.Close
Next i
Application.ScreenUpdating = True
End Sub

 

[Boss]

You made my day... Thank you so much...
Thanks!!
Boss

 

[Otto Moehrbach]

Glad it worked for you. Otto

You made my day... Thank you so much...
Thanks!!
Boss