help in macro needed

[vinod9111]

Hi All,I am trying to write a macro which will provide districrt wise position . I have a worksheets which has many sheets , data sheets is Disbursement, outstanding and acp target, these are data at national level. There are three sheets where the district wise data needs to be placed , the macro has to filter data by district name in disbursement, outstanding and acp targets and will place data in three sheets( place disbursement, place outsanding, place target), which is linked to report formats. once the data is placed the output sheets to be copied and saved as different file by distict name. I have written a macro by after copying the data from disbursement sheet and placing the data in "place disbursement" sheet, it is not filtering the data in outstanding sheet and pastes the disbursement data in "place disbrusement sheets. please go through the below code and let me know where i am making mistakes.Sub multplrept()Dim dist As Range, curwbk As Workbook, newwb As Workbook, My_Rangedisb As Range, My_Rangeos As Range, My_Rangetarg As Range, filname As String, foldername As String, Lastrowdisb As Long, Lastrowos As Long, Lastrowtarg As LongWith Application.ScreenUpdating = False.DisplayAlerts = FalseEnd WithSet curwbk = ActiveWorkbookLastrowdisb = Sheets("disbursement").Cells(Rows.Count, 3).End(xlUp).RowLastrowos = Sheets("outstanding").Cells(Rows.Count, 3).End(xlUp).RowLastrowtarget = Sheets("target districtwise").Cells(Rows.Count, 3).End(xlUp).Rowfoldername = curwbk.Path & "\" & "LBR"MkDir foldernameSet My_Rangedisb = Range("A1:G" & Lastrowdisb)Set My_Rangeos = Range("A1:F" & Lastrowos)Set My_Rangetarg = Range("A1:K" & Lastrowtarget)For Each dist In Range("distlist")[distname] = dist.ValueDoEventsfilname = Worksheets("disbursement").Range("L1").ValueSheets("disbursement").SelectMy_Rangedisb.AutoFilter Field:=2, Criteria1:="=" & [distname].ValueMy_Rangedisb.Parent.AutoFilter.Range.CopySheets("Place disbursement").ActivateRange("d5").SelectSelection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False Application.CutCopyMode = FalseSheets("outstanding").SelectMy_Rangeos.AutoFilter Field:=2, Criteria1:="=" & [distname].ValueMy_Rangeos.Parent.AutoFilter.Range.CopySheets("Place outstanding").ActivateRange("c4").SelectSelection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False Application.CutCopyMode = FalseSheets("target districtwise").SelectMy_Rangetarg.AutoFilter Field:=2, Criteria1:="=" & [distname].ValueMy_Rangetarg.Parent.AutoFilter.Range.CopySheets("ACP").ActivateRange("c2").SelectSelection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False Application.CutCopyMode = FalseSheets(Array("LBR_2_U2", "LBR_3_U3", "LBR_3_U3_B", "Banking Statistics - 1", "Banking Statistics - 2", "Banking Statistics - 3", "Banking Statistics - 4", "Doubling of Agricultural Credit", "Gist for Meeting", "LBS-MIS")).CopySet newwb = ActiveWorkbookWith ActiveSheet.UsedRange.Value = .ValueEnd WithRange("a1").Selectnewwb.SaveAs foldername & "\" & filname & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=Falsenewwb.Close Falsecurwbk.Activate[disbpastedata].Clear[ospastedata].Clear[acppastedata].ClearNextWith Application.ScreenUpdating = True.DisplayAlerts = TrueEnd WithEnd Sub

 

[vinod9111]

Reposting the code as it was not clear in the first post.

Sub multplrept()
Dim dist As Range, curwbk As Workbook, newwb As Workbook, My_Rangedisb As Range, My_Rangeos As Range, My_Rangetarg As Range, filname As String, foldername As String, Lastrowdisb As Long, Lastrowos As Long, Lastrowtarg As Long
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Set curwbk = ActiveWorkbook
Lastrowdisb = Sheets("disbursement").Cells(Rows.Count, 3).End(xlUp).Row
Lastrowos = Sheets("outstanding").Cells(Rows.Count, 3).End(xlUp).Row
Lastrowtarget = Sheets("target districtwise").Cells(Rows.Count, 3).End(xlUp).Row
foldername = curwbk.Path & "\" & "LBR"
MkDir foldername
Set My_Rangedisb = Range("A1:G" & Lastrowdisb)
Set My_Rangeos = Range("A1:F" & Lastrowos)
Set My_Rangetarg = Range("A1:K" & Lastrowtarget)
For Each dist In Range("distlist")
[distname] = dist.Value
DoEvents
filname = Worksheets("disbursement").Range("L1").Value
Sheets("disbursement").Select
My_Rangedisb.AutoFilter Field:=2, Criteria1:="=" & [distname].Value
My_Rangedisb.Parent.AutoFilter.Range.Copy
Sheets("Place disbursement").Activate
Range("d5").Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("outstanding").Select
My_Rangeos.AutoFilter Field:=2, Criteria1:="=" & [distname].Value
My_Rangeos.Parent.AutoFilter.Range.Copy
Sheets("Place outstanding").Activate
Range("c4").Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("target districtwise").Select
My_Rangetarg.AutoFilter Field:=2, Criteria1:="=" & [distname].Value
My_Rangetarg.Parent.AutoFilter.Range.Copy
Sheets("ACP").Activate
Range("c2").Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets(Array("LBR_2_U2", "LBR_3_U3", "LBR_3_U3_B", "Banking Statistics - 1", "Banking Statistics - 2", "Banking Statistics - 3", "Banking Statistics - 4", "Doubling of Agricultural Credit", "Gist for Meeting", "LBS-MIS")).Copy
Set newwb = ActiveWorkbook
With ActiveSheet.UsedRange
.Value = .Value
End With
Range("a1").Select
newwb.SaveAs foldername & "\" & filname & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
newwb.Close False
curwbk.Activate
[disbpastedata].Clear
[ospastedata].Clear
[acppastedata].Clear
Next
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub

 

[vinod9111]

Hi All,I am trying to write a macro which will provide districrt wise position . I have a worksheets which has many sheets , data sheets is Disbursement, outstanding and acp target, these are data at national level. There are three sheets where the district wise data needs to be placed , the macro has to filter data by district name in disbursement, outstanding and acp targets and will place data in three sheets( place disbursement, place outsanding, place target), which is linked to report formats. once the data is placed the output sheets to be copied and saved as different file by distict name. I have written a macro by after copying the data from disbursement sheet and placing the data in "place disbursement" sheet, it is not filtering the data in outstanding sheet and pastes the disbursement data in "place disbrusement sheets. please go through the below code and let me know where i am making mistakes. the codes are posted in the earlier post, please have a look at the same and suggest.

 

[vinod9111]

bump....