Hi all,
Am trying to write a code which will filter in a sheet which contains data, copy the data basis the district and paste to the second sheet which is again linked to the ouput sheet i.e. the third sheet, copy the third sheet as new work book and save it. Run the macro till the last district.
Below is the code but i am getting run 1004 error, any help would be appeciated
Sub multplrept()
Dim dist As Range, curwbk As Workbook, newwb As Workbook, My_Range As Range, filname As String, Lastrow As Long
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Lastrow = Sheets("GIST").Cells(Rows.Count, 3).End(xlUp).Row
filname = Worksheets("Place Outstanding").Range("F2").Value
Set My_Range = Range("A1:F" & Lastrow)
Set curwbk = ActiveWorkbook
For Each dist In Range("fipdist")
[fipdistname] = dist.Value
DoEvents
Sheets("GIST").Select
My_Range.AutoFilter Field:=2, Criteria1:="=" & [fipdistname].Value
My_Range.Parent.AutoFilter.Range.Copy
Sheets("Place Outstanding ").Select
Range("c5").Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
Sheets("FIP").Copy
Set newwb = ActiveWorkbook
With ActiveSheet.UsedRange
.Value = .Value
End With
Range("a1").Select
newwb.SaveAs filename:="D:\FIP" & filname & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
newwb.Close False
Next
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
Am trying to write a code which will filter in a sheet which contains data, copy the data basis the district and paste to the second sheet which is again linked to the ouput sheet i.e. the third sheet, copy the third sheet as new work book and save it. Run the macro till the last district.
Below is the code but i am getting run 1004 error, any help would be appeciated
Sub multplrept()
Dim dist As Range, curwbk As Workbook, newwb As Workbook, My_Range As Range, filname As String, Lastrow As Long
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Lastrow = Sheets("GIST").Cells(Rows.Count, 3).End(xlUp).Row
filname = Worksheets("Place Outstanding").Range("F2").Value
Set My_Range = Range("A1:F" & Lastrow)
Set curwbk = ActiveWorkbook
For Each dist In Range("fipdist")
[fipdistname] = dist.Value
DoEvents
Sheets("GIST").Select
My_Range.AutoFilter Field:=2, Criteria1:="=" & [fipdistname].Value
My_Range.Parent.AutoFilter.Range.Copy
Sheets("Place Outstanding ").Select
Range("c5").Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
Sheets("FIP").Copy
Set newwb = ActiveWorkbook
With ActiveSheet.UsedRange
.Value = .Value
End With
Range("a1").Select
newwb.SaveAs filename:="D:\FIP" & filname & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
newwb.Close False
Next
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub