nrk
03-25-2019, 03:45 AM
I want to copy two sheets to a new workbook from master workbook then it rename according to master workbook master sheet list and save . also second list copy every new workbook first sheet A1 cell.
it works fine but when i was looping rename according list . It was occurring replace excel message and copy data wrongly.
Please help
Sub ExportSheets()
Dim wb As Workbook
Dim x As Long
Dim last As Long
Dim y As Long
last = Workbooks("Master").Worksheets("Master").Cells(Rows.Count, "A").End(xlUp).Row
last1 = Workbooks("Master").Worksheets("Master").Cells(Rows.Count, "B").End(xlUp).Row
Set wb = ActiveWorkbook
Sheets(Array(2, 3)).Copy
For x = 2 To last
Workbooks("Master").Worksheets("Master").Cells(x, 1).Copy
ActiveWorkbook.Worksheets(1).Cells(1, 1).PasteSpecial Paste:=xlPasteFormulas
'For y = 2 To last1
'ActiveWorkbook.SaveAs "C:\Users\nkelaniy\Desktop\" & Workbooks("Master").Worksheets("Master").Cells(y, 2) & ".xlsx"
ActiveWorkbook.SaveAs "C:\Users\nkelaniy\Desktop\" & ActiveWorkbook.Worksheets(1).Cells(1, 1) & ".xlsx"
'Next
Next
End Sub
it works fine but when i was looping rename according list . It was occurring replace excel message and copy data wrongly.
Please help
Sub ExportSheets()
Dim wb As Workbook
Dim x As Long
Dim last As Long
Dim y As Long
last = Workbooks("Master").Worksheets("Master").Cells(Rows.Count, "A").End(xlUp).Row
last1 = Workbooks("Master").Worksheets("Master").Cells(Rows.Count, "B").End(xlUp).Row
Set wb = ActiveWorkbook
Sheets(Array(2, 3)).Copy
For x = 2 To last
Workbooks("Master").Worksheets("Master").Cells(x, 1).Copy
ActiveWorkbook.Worksheets(1).Cells(1, 1).PasteSpecial Paste:=xlPasteFormulas
'For y = 2 To last1
'ActiveWorkbook.SaveAs "C:\Users\nkelaniy\Desktop\" & Workbooks("Master").Worksheets("Master").Cells(y, 2) & ".xlsx"
ActiveWorkbook.SaveAs "C:\Users\nkelaniy\Desktop\" & ActiveWorkbook.Worksheets(1).Cells(1, 1) & ".xlsx"
'Next
Next
End Sub