Copy data to user created sheet(VBA).

[yvettet]

HI Everyone.

I am quite new to VBA(also this forum) and I need your assistance please. Let me give you some background first

I have created a worksheet called PSD_Import with 4 tabs. The first tab is where the user copies the data to. The next two tabs are tables with calculations that refresh from the first tab and the last tab is just contains 1 line of info. I want to create a macro where the user clicks on the button, a new sheet will be created(User to specify the name of the sheet) and then the data in the 3 tabs on my sheet will copy and paste special into the newly created sheet. I have created the code for the user to create the sheet and the code to copy the data across but I dont know how to specify the file the user created. Please see my code below:

Sub CreateWB()

Dim wb As Workbook
Dim fname As String, fPathfile As String
fname = InputBox("Enter the file name to use")
Set wb = Workbooks.Add
fPathfile = Application.GetSaveAsFilename(fname, "Excel Files(*.xlsx), *.xlsx")
wb.SaveAs fPathfile
With wb
    .Sheets.Add.Name = "Invoices"
    .Sheets.Add(After:=Sheets("Invoices")).Name = "Invoice_Details"
    .Sheets("Sheet1").Name = "Invoice_Payment_Schedule"
End With

Dim FileToOpen As String
    FileToOpen = Application.GetOpenFilename
    Workbooks.Open (FileToOpen)




End Sub

Sub Copy_tabs()
'
' Copy_tabs Macro
'

'
    Workbooks.Add
    Windows("PSD_Import_new.xlsm").Activate
    Sheets("Invoices").Select
    Cells.Select
    Selection.Copy
    Windows("Book5").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets.Add After:=ActiveSheet
    Windows("PSD_Import_new.xlsm").Activate
    Sheets("Invoice_Details").Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Book5").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "Invoices"
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "Invoice_Details"
    Sheets.Add After:=ActiveSheet
    Windows("PSD_Import_new.xlsm").Activate
    Sheets("Invoice_Payment_Schedules").Select
    Range("A1:I1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Book5").Activate
    ActiveSheet.Paste
    Sheets("Sheet3").Select
    Sheets("Sheet3").Name = "Invoice_Payment_Schedules"
    Windows("PSD_Import_new.xlsm").Activate
End Sub

 

[yvettet]

Hi guys

I toot a different approach. I created a file myself. As part of my code,the script opens the file, does all the copying and then when it comes to saving the user can specify a file name.

Sub Copy()

'Select the File
Dim FileToOpen As String
    FileToOpen = Application.GetOpenFilename
    Workbooks.Open (FileToOpen)

 'Copy
  Workbooks("PSD_Import_Tool.xlsm").Worksheets("Invoices").Range("A1:m1000").Copy
   Workbooks("Import_File.xlsx").Worksheets("Invoices").Range("A1").PasteSpecial Paste:=xlPasteValues
  
   Workbooks("PSD_Import_Tool.xlsm").Worksheets("Invoice_Details").Range("A1:m1000").Copy
   Workbooks("Import_File.xlsx").Worksheets("Invoice_Details").Range("A1").PasteSpecial Paste:=xlPasteValues

 Workbooks("PSD_Import_Tool.xlsm").Worksheets("Invoice_Payment_Schedules").Range("A1:M1").Copy
  Workbooks("Import_File.xlsx").Worksheets("Invoice_Payment_Schedules").Range("A1").PasteSpecial Paste:=xlPasteValues
  
'Save As a new file name
Dim result As Variant
result = Application.GetSaveAsFilename(filefilter:="Excel Files (*.xlsx),*.xlsx")
'If VarType(result) = vbBoolean Then Exit Sub
Workbooks("Import_File").SaveAs Filename:=result, FileFormat:=51

'Save the macro workbook
Workbooks("PSD_Import_Tool").Save


'Close Saved Worksheet
Dim WB As Workbook
 For Each WB In Workbooks
 If WB.Name <> ThisWorkbook.Name Then
 WB.Close SaveChanges:=False
 End If
 Next
 ThisWorkbook.Close SaveChanges:=True

End Sub

 

[GWteB]

Another way to copy a set of particular sheets to a new workbook and have the formulas replaced by values:

  ThisWorkbook.Sheets(Array("Invoices", "Invoice_Details", "Invoice_Payment_Schedules")).Copy
  Set oWb = ActiveWorkbook
  For Each oWs In oWb.Worksheets
        oWs.Cells.Copy
        oWs.[A1].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  Next oWs
  Application.CutCopyMode = False