PDA

View Full Version : [SOLVED] How to copy sheets from workbook to new open workbook and rename new workbook accordi



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

大灰狼1976
03-26-2019, 12:25 AM
Hi nrk!
Not sure, an attachment is helpful.

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
'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\" & Workbooks("Master").Worksheets("Master").Cells(x, 1) & ".xlsx"
'Next
Next
EndSub


--Okami

akocak4
03-26-2019, 03:38 AM
Hello,

I am also new here. But I have learned many things from this forum. here is my solution for your question:


Sub ExportSheets()
Dim wb As Workbook
Dim x As Long
Dim last As Long
Dim y As Long
last = Worksheets("Master").Cells(Rows.Count, "B").End(xlUp).Row
'last1 = Worksheets("Master").Cells(Rows.Count, "C").End(xlUp).Row
Dim zz As Long
ReDim SName(last) As Variant
ReDim temp(last) As Variant
For zz = 1 To last
temp(zz) = Cells(zz, 2)
SName(zz) = "C:\Users\nkelaniy\Desktop" & ActiveWorkbook.Worksheets("Master").Cells(zz, 2) & ".xlsx"
Next zz
For x = 1 To last
Sheets(Array(x + 1)).Copy
ActiveWorkbook.SaveAs SName(x)
Workbooks("Master1.xlsm").Activate
Next
End Sub

snb
03-26-2019, 04:39 AM
Assuming 2 sheets in the source workbook, named 'snb' and 'snb2'.

Sub M_snb()
Sheets(Array("snb", "snb2")).Copy
With ActiveWorkbook
.SaveAs "G:\OF\snb.xlsb", 50
.Close 0
End With
End Sub

nrk
05-23-2019, 08:58 PM
Hi Thanks for your valuable support snb and acokak 4

i have done . it's working fine


Sub ExportSheets()Dim x As Range
Dim i As Long
Dim wb As Workbook
Dim ws As Worksheet
Dim master As String
master = "Master.xlsm"
Set wb = Workbooks(master)
Set ws = wb.Sheets("Master")
For i = 2 To Range("a300").End(xlUp).Row
Workbooks("Master.xlsm").Activate
Sheets(Array(2, 3)).Copy
ActiveWorkbook.Sheets(1).Cells(1, 1).Value = ws.Cells(i, 1)
ActiveWorkbook.Sheets(2).Cells(5, 4).Value = ws.Cells(i, 2)
ActiveWorkbook.SaveAs ThisWorkbook.Path & "" & _
ws.Cells(i, 3) & ".xlsx"
ActiveWorkbook.Close SaveChanges:=True
Application.DisplayAlerts = True
Next
End Sub