When I run my code I get a "400" error message. but it is only the last part of my code that doesn't work("creating template"). Im trying to copy cells A1:BA1000 from the sheet "Data" to a new sheet which is named based on the value of cell EU12 in the data sheet.
'copy the last values from december
Range("HI5:IA1000").Select
Selection.Copy
Range("IC5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'copy the date to new workbook.
Range("EU8").Select
Selection.Copy
Range("EU12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'copy sheet to new workbook
sheettocopy = Range("EU10").Value
Worksheets(sheettocopy).Copy
'adding sheet and renaming
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = Sheets("Data").Range("EU12").Value
'creating template
Sheets("Data").Select
Range("A1:BA1000").Select
Selection.Copy
ActiveWorkbook.Sheets(Worksheets("Data").Range("EU12").Value).Activate
Range("A1").Select
ActiveSheet.Paste
EDIT:
made a new macro just for the creation of a template, the code works(when stored in a module) but when i copy my first sheet in the beginning the module doesnt follow:
Sub addinfo()
'creating template
Set wk = ThisWorkbook
Dim template As String
template = Sheets("Data").Range("EU12").Value
wk.Sheets("Data").Range("A1:BA1000").Copy wk.Sheets(template).Range("A1")
End Sub
Related
I'm trying to copy data from a pivot table to a new sheet as a common data in vba. I want to preserve formatting of the pivot table (tab delimiter of subitems, bold font of groups and so on).
It is working correctly when I manually copy the pivot table and paste it with "Values & Source formatting" button.
When I record macro of function described above I get this code:
Sub Macro()
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
But when I use this macro in my code (Selection is replaced by a range) then data is copied but without format.
Here is my code:
Set sh = WB1.Sheets("RESULT")
WB1.Sheets("PIVOT").Range("A1:D" & lRow).Copy
sh.Range("A1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
sh.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Try this
sh.Range("A1").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
sh.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Pivot Table Formatting
Copy the code into a standard module (e.g. Module1).
Adjust the constants including the workbook.
I'm afraid this is the closest I could get. All other solutions I've tried including the one you mentioned give you a copy of the Pivot Table, not a 'free' range.
Interesting Links
TableRange1
TableRange2
TableStyle2
The Code
Option Explicit
Sub pastePivotTable()
' Source
Const srcName As String = "PIVOT"
Const pivName As String = "PivotTable1"
' Target
Const tgtName As String = "RESULT"
Const tgtFirst As String = "A1"
' Workbook
Dim wb As Workbook: Set wb = ThisWorkbook
Dim piv As PivotTable: Set piv = wb.Worksheets(srcName).PivotTables(pivName)
Dim rng As Range: Set rng = wb.Worksheets(tgtName).Range(tgtFirst)
piv.TableRange1.Copy
rng.PasteSpecial xlPasteFormats
rng.PasteSpecial xlPasteValues
End Sub
I am trying to create a form in excel in Sheet 1 (named Form) where the data copied from Sheet 1 (Form) is pasted to Sheet 2 (Data).
The form is vertical; however, the data is horizontal.
As such, I am using PasteSpecial.
When I use the macro button to paste and clear the data from the "Form" to the "Data", it is works for the first and second use. On the third use, the data is pasted on the second set of data rather than in a new row.
Sub Submit()
'
' Submit Macro
'
'
Range("C2:C14").Select
Selection.Copy
Sheets("Data").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Range("A3").Select
Sheets("Form").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("C2").Select
End Sub
Does this work?
Sub Submit()
Sheets("Form").Range("C2:C14").Copy
Sheets("Data").Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues, Transpose:=True
End Sub
You can read this to find out how to avoid using Select/Activate.
I am trying to copy the range of value from one sheet in excel to another. I have copied this formula from another part of my sheet that works however i cam coming up with the run time error 9.
Sub SaveJambStudEC()
'
' SaveCalcsJambEC Macro
'
Dim page As Integer
page = Cells(4, "T").Value
Range("A70:AN70").Select
Selection.Copy
Range("A71").Select
ActiveCell.Offset(page, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1:O63").Select
Selection.Copy
Sheets("10.3 JambCalcs EC").Select
Range("A1").Select
ActiveCell.Offset((page - 1) * 63, 0).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats
Sheets("9.3 Jamb Design EC").Select
Range("T5").Select
Selection.Copy
Range("N9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("T31").Value = 0
Call JambECsetDesignOptions
Call CopyJambOptiValues
Range("J9").Activate
End Sub
using the below code you will check if there is a sheet with that name. if you dont receive any message box means that there is no sheet with such name
Option Explicit
Sub test()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "10.3 JambCalcs EC" Then
MsgBox "Sheet Appears"
Exit Sub
End If
Next ws
End Sub
Note
'ThisWorkbook' refer to the workbook that the code included. If you want to clearly declare the workbook you could declare a variable 'Dim wb as Workbook' and then set the workbook 'Set wb=Workbooks("workbook name")'
I have a workbook of 80 worksheets,and I want to select only 4 worksheets with selected range. I want to copy this range a new workbook automatically. I have run a macro and this code below.
Sub TestTest()
'
' TestTest Macro
'
'
Sheets("Summary").Select
Range("A1:O54").Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:="Newworkbook.xlsx",
FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
Windows("").Activate
Sheets("").Select
Range("").Select
Selection.Copy
Windows("Newworkbook.xlsx").Activate
Sheets.Add After:=ActiveSheet
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("").Activate
Sheets("").Select
Range("").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Newworkbook.xlsx").Activate
Sheets.Add After:=ActiveSheet
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("").Activate
Sheets("").Select
Range("").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Newworkbook.xlsx").Activate
Sheets.Add After:=ActiveSheet
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("").Activate
Sheets("").Select
ActiveWindow.SmallScroll Down:=-18
Range("").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Newworkbook.xlsx").Activate
Sheets.Add After:=ActiveSheet
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("").Activate
Range("N29").Select
End Sub
I believe it should work as you expect it to, it will copy all five ranges and paste them into a new workbook, renaming each of the sheets appropriately and then save the newly created workbook to your desired location, you might want to add something to the name of the new workbook you are creating, such as a date, so as to not give you any issues the next time you run the code, alternatively you could delete the previous report and overwrite it:
Sub Test()
Dim wsSummary As Worksheet: Set wsSummary = ThisWorkbook.Sheets("Summary")
Dim wsMeasured As Worksheet: Set wsMeasured = ThisWorkbook.Sheets("1. Measured Work")
Dim wsPreliminaries As Worksheet: Set wsPreliminaries = ThisWorkbook.Sheets("2. Preliminaries")
Dim wsFees As Worksheet: Set wsFees = ThisWorkbook.Sheets("3. Fees")
Dim wsContingency As Worksheet: Set wsContingency = ThisWorkbook.Sheets("4. Contingency")
Dim NewWorkBook As Workbook
'above declare and set the worksheets and workbook you are working with
Application.ScreenUpdating = False
Set NewWorkBook = Workbooks.Add
'add a new workbook
wsSummary.Range("A1:O54").Copy 'copy first range
NewWorkBook.Sheets(1).Range("A1").PasteSpecial xlPasteValues
NewWorkBook.Sheets(1).Range("A1").PasteSpecial xlPasteFormats
'paste into first sheet in new workbook
NewWorkBook.Sheets(1).Name = "Summary" 'rename the sheet in the new workbook
wsMeasured.Range("B1:Q76").Copy 'copy second range
NewWorkBook.Sheets.Add After:=ActiveSheet 'add a new sheet to the new workbook
NewWorkBook.Sheets(2).Range("A1").PasteSpecial xlPasteValues
NewWorkBook.Sheets(2).Range("A1").PasteSpecial xlPasteFormats
'paste into second sheet in new workbook
NewWorkBook.Sheets(2).Name = "1. Measured Work" 'rename the sheet in the new workbook
wsPreliminaries.Range("B1:Q48").Copy 'copy third range
NewWorkBook.Sheets.Add After:=ActiveSheet 'add a new sheet to the new workbook
NewWorkBook.Sheets(3).Range("A1").PasteSpecial xlPasteValues
NewWorkBook.Sheets(3).Range("A1").PasteSpecial xlPasteFormats
'paste into third sheet in new workbook
NewWorkBook.Sheets(3).Name = "2. Preliminaries" 'rename the sheet in the new workbook
wsFees.Range("B1:Q47").Copy 'copy fourth range
NewWorkBook.Sheets.Add After:=ActiveSheet 'add a new sheet to the new workbook
NewWorkBook.Sheets(4).Range("A1").PasteSpecial xlPasteValues
NewWorkBook.Sheets(4).Range("A1").PasteSpecial xlPasteFormats
'paste into fourth sheet in new workbook
NewWorkBook.Sheets(4).Name = "3. Fees" 'rename the sheet in the new workbook
wsContingency.Range("B1:Q46").Copy 'copy fifth range
NewWorkBook.Sheets.Add After:=ActiveSheet 'add a new sheet to the new workbook
NewWorkBook.Sheets(5).Range("A1").PasteSpecial xlPasteValues
NewWorkBook.Sheets(5).Range("A1").PasteSpecial xlPasteFormats
'paste into fifth sheet in new workbook
NewWorkBook.Sheets(5).Name = "4. Contingency" 'rename the sheet in the new workbook
Application.CutCopyMode = False 'deselect copied range
NewWorkBook.SaveAs Filename:="NewWorkBook.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
'save the newly created workbook
NewWorkBook.Close
'close the newly created workbook
Application.ScreenUpdating = True
End Sub
.....on a separate workbook indefinitely.
Hello First off I am new here and very new to VBA. I have a workbook that has a list that will grow indefinitely named "book1" and the code i pieced together grabs data from a range in that book and pastes it into another book "DMAutocalcs"in one specific row one at a time and the the code executes a refresh and wait time, after which it copy certain pricing date from a specific range in "DMautoCalcs" back into Book1. As of Now i am manually copying the code and modifying it for each range of calls it needs to transfer. so there in lies the issue, inherently it will be limited by the number of times i wish to copy what i have existing. I intend to modify the code to loop and perform the copy paste between the workbooks until it reaches an empty cell in "book1" however every attempt i have made has failed, it only continually works the same ranges over and over unless i manually copy the code and modify for each new line. i fear i do not fully understand the range rows and cell aspects when it comes to relatives and absolutes and the proper syntax on how to call the out accurately.
how do i achieve this? Any help would be appreciated.
Public Sub macro_54()
' Keyboard Shortcut: Ctrl+p
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
Workbooks.Open ("C:\Users\Legacy\Desktop\DMAutoCalcs.xlsm")
Windows("Book1.xlsm").Activate
Range("a2:l2").Select
Selection.Copy
Windows("DMAutoCalcs.xlsm").Activate
Range("a1:q1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Refresh
ActiveWorkbook.RefreshAll
Application.Wait (Now + TimeValue("0:00:03"))
ActiveWorkbook.RefreshAll
Windows("DMAutoCalcs.xlsm").Activate
Range("T2:x2").Select
'Application.CutCopyMode = False
Selection.Copy
Windows("Book1.xlsm").Activate
Range("M2:q2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' copy from calcs pricing info and past into pricelist
' return to pricelist
' Selects cell down 1 row from active cell.
'New Line
Windows("Book1.xlsm").Activate
Range("a3:l3").Select
Selection.Copy
Windows("DMAutoCalcs.xlsm").Activate
Range("a1:q1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Refresh
ActiveWorkbook.RefreshAll
Application.Wait (Now + TimeValue("0:00:03"))
ActiveWorkbook.RefreshAll
Windows("DMAutoCalcs.xlsm").Activate
Range("T2:x2").Select
'Application.CutCopyMode = False
Selection.Copy
Windows("Book1.xlsm").Activate
Range("M3:q3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' copy from calcs pricing info and past into pricelist
' return to pricelist
' Selects cell down 1 row from active cell.
'New Line
Windows("Book1.xlsm").Activate
Range("a4:l4").Select
Selection.Copy
Windows("DMAutoCalcs.xlsm").Activate
Range("a1:q1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Refresh
ActiveWorkbook.RefreshAll
Application.Wait (Now + TimeValue("0:00:03"))
ActiveWorkbook.RefreshAll
Windows("DMAutoCalcs.xlsm").Activate
Range("T2:x2").Select
'Application.CutCopyMode = False
Selection.Copy
Windows("Book1.xlsm").Activate
Range("M4:q4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' copy from calcs pricing info and past into pricelist
' return to pricelist
'
' Selects cell down 1 row from active cell.
' And so on and so forth....
Windows("DMAutoCalcs.xlsm").Activate
ActiveWorkbook.Close savechanges:=False
Windows("Book1.xlsm").Activate
'Determine how many seconds code took to run
SecondsElapsed = Round(Timer - StartTime, 2)
'Notify user in seconds
MsgBox "All Ranges Updated, Calc sheet closed successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub
You need not to select or activate a range or window before copying and pasting. Below is the modified code from I can understand you.
Sub macro_54_Modified()
'Let your working sheets in Book1 and DMAutoCalcs are Sheet1 and Sheet2, respectively
Workbooks.Open "C:\Users\Legacy\Desktop\DMAutoCalcs.xlsm"
Dim wsDm As Worksheet, wsB1 As Worksheet, lastRow As Long, i As Long
Set wsB1 = Workbooks("Book1.xlsm").Sheets("Sheet1")
Set wsDm = Workbooks("DMAutoCalcs.xlsm").Sheets("Sheet2")
'Last row number in column A
lastRow = wsB1.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastRow
wsB1.Range("A2:L2").Offset(i - 2).Copy wsDm.Range("a1:q1")
'VBA code for Refresh ... ?
wsDm.Range("T2:X2").Copy wsB1.Range("M2:q2").Offset(i - 2)
Next i
End Sub