This isn't greatly elegent, but should get you started ok...paste the code
into a new module
ALT+F11 opens the VBA editor, the INSERT/MODULE from the menu
Option Explicit
Dim wb As Workbook
Dim ws As Worksheet
Dim source As Range
Const TARGETFOLDER As String = "C:\Records\"
Sub Main()
Dim rw As Long
Set source = ThisWorkbook.Worksheets("data").Range("A:A")
rw = 2
With ThisWorkbook.Worksheets("Main")
Do Until .Cells(rw, 1) = ""
If MatchedItem(.Cells(rw, 1)) Then
Set wb = GetWB(.Cells(rw, "E").Value)
Set ws = GetWS(.Cells(rw, "B").Value)
ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(1).Resize(1,
5).Value = _
.Cells(rw, 1).Resize(, 5).Value
wb.Close True
End If
rw = rw + 1
Loop
End With
End Sub
Function MatchedItem(Chrg As String) As Boolean
Dim rec As Long
On Error Resume Next
rec = WorksheetFunction.Match(Chrg, source, False)
MatchedItem = (rec <> 0)
On Error GoTo 0
End Function
Function GetWB(wbName As String) As Workbook
On Error Resume Next
Set wb = Workbooks.Open(TARGETFOLDER & wbName & ".xls")
If Err.Number <> 0 Then
Err.Clear
Set wb = Workbooks.Add(1)
wb.SaveAs TARGETFOLDER & wbName
'ThisWorkbook.Worksheets("Template").Copy wb.Worksheets(1)
End If
Set GetWB = wb
End Function
Function GetWS(wsName As String) As Worksheet
On Error Resume Next
Set ws = wb.Worksheets(wsName)
If Err.Number <> 0 Then
Err.Clear
On Error GoTo 0
ThisWorkbook.Worksheets("Template").Copy wb.Worksheets(1)
wb.Worksheets(1).Name = wsName
Set ws = wb.Worksheets(wsName)
End If
Set GetWS = ws
End Function
"K" wrote:
> A B C D E….col
> Chrg App Total Amt Name…..headings
> LA1 F01 7780 2190 DAVID
> LA1 F21 7781 2191 DAVID
> LA1 G61 7782 2192 DAVID
> D35 G83 7783 2193 JOHN
> D35 G87 7784 2194 JOHN
> D35 G87 7785 2195 JOHN
> D31 G87 7786 2196 ALI
> D31 LC1 7787 2197 ALI
> D31 LE1 7788 2198 ALI
> G68 G68 7789 2199 STEVE
> G68 G70 7790 2200 STEVE
> G68 NA1 7791 2201 ROB
> G68 PA1 7792 2202 ROB
>
>
> I have three sheets in workbook with the names "MAIN" , "DATA" and
> "TEMPLATE". In sheet "DATA" I have above data. In column A of sheet
> "MAIN" I have data (see below)
>
> A….col
> Chrg….heading
> LA1
> D31
> MC3
> G68
> F23
>
> I want macro something like (see below)
>
> 1 - check column A values of sheet "MAIN" in column A of sheet "DATA"
> 2 - if values exist in sheet "DATA" then copy sheet "TEMPLATE" into
> new workbook
> 3 - name new workbook with the unique value in column E of sheet
> "DATA" which will be in same row of existing values
> 4 - create tabs in new workbook and give them name of column B values
> of sheet "DATA" which will also in same row of existing values
> 5 - put column C and D figures of sheet "DATA" in cells A1 and B1 of
> new created tabs
> 6 - save new create workbook on path "C:\Records"
> 7 - next until there is no value left in column A of sheet "MAIN"
>
> (bit more detail given below for more understading)
>
> 1 - check cell A1 value of sheet "MAIN" (which is "LA1") in column A
> of sheet "DATA"
> 2 - if "LA1" exists in column A of sheet "DATA" then copy sheet
> "TEMPLATE" into new workbook
> 3 - name new workbook with the unique value in column E of sheet
> "DATA" coming in same row of value "LA1" (which is "DAVID")
> 4 - create tabs in new workbook and give them name of column B value
> of sheet "DATA" which will also in same row of value "LA1" (which will
> be "F01" , "F21 and "G61")
> 5 - put column C and D figures of sheet "DATA" which are in same row
> of values "F01" , "F21" and "G61" in cells A1 and B1 of new created
> tabs.
> 6 - save new create workbook on path "C:\Records"
> 7 - next until there is no value left in column A of sheet "MAIN"
>
> I'll be very thankful to the friend who can help on this
> .
>
|
Similar Threads
