September 6, 2019
Hi folks,
Hope everyone is well
Could you please help me to create macro to do below steps.
- First Tab will contain Template.
- Second Tab will contain all Data need to separate it in the template to separated files.
- Each file will contain the Manufacturer Name and all Manufacturer PN.
- The file will be named by MFR name after removing special characters. Ex: Intel, Inc, so file name should be IntelInc
- The separated files will be filled based in MFR name. as Col A will contain MFR name, Column B will contain MFR PN, Column C will contain the Required Data. All data available from second sheet.
- If the MFR PN is duplicate due it have multi required data, it should collected in one cell separated by |
Please check attached sample.
Your assistance is greatly appreciated.
Thanks;
Marsil
Trusted Members
December 20, 2019
Hi Marsil
I have had a quick look and it seems you want a fairly comprehensive process automated – have you made a start with coding this or do you already have a manual process with formulas that achieves the desired result?
Most of the time these forums are for people to troubleshoot a problem or learn how to do something quite complex.
If you can post what part is causing the issue I am sure there are people on here that can help.
Trusted Members
December 20, 2019
I have added some loops at the bottom to copy over formatting etc
Dim fRange As Range
Dim tRange As Range
Set tRange = Worksheets("Template").Range("a1:f4")
Set fRange = Worksheets("Template").Range("a1").CurrentRegion
'fRange.Copy
Set P1 = Worksheets("Template").Shapes.Copy
'Top Bit
tRange.Copy
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Template" Then
ws.Activate
ws.Range("a1:f4").PasteSpecial xlPasteAll
'ws.Range("a1").PasteSpecial xlPasteColumnWidths
End If
Next ws
'Column Widths
fRange.Copy
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Template" Then
ws.Activate
ws.Range("a1").PasteSpecial xlPasteColumnWidths
ws.Range("a1").CurrentRegion.Rows.AutoFit
ws.Range("1:3").Rows.RowHeight = 23
End If
Next ws
'Logo
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Template" Then
Worksheets("Template").Range("a1:a3").CopyPicture xlScreen, xlPicture
ws.Paste Destination:=ws.Range("a1")
End If
Next ws
Answers Post
1 Guest(s)