Copy data to user created sheet(VBA).

yvettet

New Member
Joined
Jan 15, 2021
Messages
2
Office Version
  1. 365
Platform
  1. Windows
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:

VBA Code:
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

VBA Code:
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
 

Some videos you may like

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

yvettet

New Member
Joined
Jan 15, 2021
Messages
2
Office Version
  1. 365
Platform
  1. Windows
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.
VBA Code:
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

Well-known Member
Joined
Sep 10, 2010
Messages
1,295
Office Version
  1. 2013
Platform
  1. Windows
Another way to copy a set of particular sheets to a new workbook and have the formulas replaced by values:
VBA Code:
  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
 

Watch MrExcel Video

Forum statistics

Threads
1,122,243
Messages
5,595,027
Members
413,960
Latest member
ikkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top