I am still new with VBA but decided using VBA to streamline a Monthly report I am working on for our payroll would be the most efficient way, I wish to export a range I3:U2270 into a new sheet named from a cell in the summary sheet. Everything works fine except formatting.
If I use xlPasteAll the formatting is perfect, but it shows values as formulas.
If I use:
.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.PasteSpecial Paste:=xlPasteColumnWidths
.PasteSpecial Paste:=xlPasteFormats
The data and cell widths are perfect, but because some data is in Tables, it doesn't bring the formatting across.
Any ideas would be appreciated!
Sub MonthlySummaryExport()
Dim NewSheetName As String
Dim Newsheet As Object
On Error Resume Next
NewSheetName = Worksheets("Monthly Summary").Range("T1")
If NewSheetName = "" Then Exit Sub
Set Newsheet = Sheets(NewSheetName)
If Not Newsheet Is Nothing Then
MsgBox "Sheet cannot be created as there is already a worksheet with the same name" & " " & (NewSheetName)
Exit Sub
End If
Sheets.Add(, Sheets(Sheets.Count)).Name = NewSheetName
'Copy and PasteSpecial a between worksheets
Worksheets("Monthly Summary").Range("I3:U2270").Copy
With Worksheets(NewSheetName).Range("A1")
.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.PasteSpecial Paste:=xlPasteColumnWidths
.PasteSpecial Paste:=xlPasteFormats
End With
'Disable marching ants around copied range
Application.CutCopyMode = False
End Sub
Copy everything including formulas, then change formulas to values in the copy
'Copy and PasteSpecial a between worksheets
dim dest as range
set dest = Worksheets(NewSheetName).Range("A1")
Worksheets("Monthly Summary").Range("I3:U2270").Copy dest
dest.currentregion.copy
dest.pastespecial xlPasteValues
Related
I have a few tables in different worksheets that I want to compile in another sheet, however I’m having trouble getting the formatting to paste across.
My current code is:
Sub Compiler()
Dim wbRaw As Workbook
Set wbRaw = ThisWorkbook
Dim wsCompiled As Worksheet
Set wsCompiled = wbRaw.Sheets("ALL PROGRAMMES COMPILED")
Dim wsACF As Worksheet
Set wsACF = wbRaw.Sheets("ACF")
Dim wsASPIRE As Worksheet
Set wsASPIRE = wbRaw.Sheets("ASPIRE")
Application.ScreenUpdating = False
wsCompiled.Cells.ClearContents
wsACF.Cells(1, 1).CurrentRegion.Copy
With wsCompiled
.Range("A1").PasteSpecial xlPasteFormats
.Range("A1").PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
wsASPIRE.Cells(1, 1).CurrentRegion.Offset(1).Copy
With wsCompiled
.Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormats
.Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False
End Sub
The first table pastes across fine with the correct formatting, but the next table only pastes the values, with no formatting.
If I remove the offset from the copy line:
wsASPIRE.Cells(1, 1).CurrentRegion.Copy
The formatting pastes fine, but this then includes the headers from the second table which messes up the compiled data.
Can anyone explain why this happens and any suggestions how I can get around this?
I have not managed to find out why the formatting of tables does not paste across, however I figured out a workaround to the problem by looping through the tables in each worksheet and then unlisting them.:
Sub LoopTables()
Dim tbl As ListObject
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
For Each tbl In ws.ListObjects
tbl.Unlist
Next tbl
Next ws
End Sub
Sub MakeTables()
Dim wbTarget As Object
Set wb = Workbooks.Open("C:\Users\A9900899\Desktop\Desmond\VBAProject\GenerateTablesFormulas.xlsx")
Set wbTarget = Workbooks.Open("C:\Users\A9900899\Desktop\Desmond\VBAProject\USDReport.xlsx")
With wb.Sheets("Sheet1").UsedRange
.Copy
' Create the new sheet and name it at the end
With wbTarget.Sheets("HK").Range("D82:X97")
.PasteSpecial xlValues
.PasteSpecial xlFormats
End With
End With
End Sub
Can someone tell me what mistake I made here. It gives me the error that range class failed. Thank you
if you want to keep the copied range size, then:
With wb.Sheets("Sheet1").UsedRange
.Copy
' Create the new sheet and name it at the end
With wbTarget.Sheets("HK").Range("D82") '.Resize(.Rows.Count, .Columns.Count) '<--| you can omit the 'Resize' part but it can be useful to make it clear (code can be read in years to come) you want to stick to copied range size
.PasteSpecial xlValues
.PasteSpecial xlFormats
End With
End With
Application.CutCopyMode = False '<--| empty clipboard
otherwise if you want to force the copied range size to the to-be-pasted one, then:
' Create the new sheet and name it at the end
With wbTarget.Sheets("HK").Range("D82:X97") '<--| reference range you want to paste values to and keep sizes of
wb.Sheets("Sheet1").UsedRange.Resize(.Rows.Count, .Columns.Count).Copy '<--| copy the source sheet range with same sizes as referenced range
.PasteSpecial xlValues
.PasteSpecial xlFormats
End With
Application.CutCopyMode = False '<--| empty clipboard
I'm trying to copy and paste the values form another workbook with the specific sheet named Sheet1. But when I run this code:
Dim wb as Workbook
Dim conso as Worksheet
set conso = wb.Worksheets("Sheet1")
With conso
.Rows(1).EntireRow.Copy
End With
With ActiveSheet
'.Paste
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
End With
I got an error saying:
PasteSpecial method of Worksheet class failed.
I'm trying to copy all the entire row of the Sheet1 sheet to another workbook. Any help?
Try indicating where you need to paste the cells you copied:
With ActiveSheet.Rows(1)
'.Paste
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
End With
The code below works but isn't fast and I'm sure there are ways it could simplified. I'm not a coder -- I just compiled a few samples that I found. I really don't understand the range/end/offset pieces for the pasting aspect. Here's what I'm trying to do:
1. Print the first three worksheets in the workbook
2. Create three new worksheets at the end of the workbook
3. copy and paste values, formats, and column widths to the three new worksheets from the first three.
Thanks for any help you can provide!
Option Explicit
Option Base 1
Sub Print_copy_Current_Workbook()
'Prints the current active workbook in Excel
Sheets("Draw").PrintOut
Sheets("Calculations").PrintOut
Sheets("AIN").PrintOut
Application.ScreenUpdating = False
Dim Tabs As Variant
Dim I As Byte
Tabs = Array("Draw Final", "AIN Final", "Calculations Final")
For I = LBound(Tabs) To UBound(Tabs)
Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1).Name = Tabs(I)
Next I
Sheets("Draw").Range("A1:L1000").Copy
With Sheets("Draw Final").Range("iv1").End(xlToLeft).Offset(, 1)
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteColumnWidths
End With
Sheets("AIN").Range("A1:L1000").Copy
With Sheets("AIN Final").Range("iv1").End(xlToLeft).Offset(, 1)
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteColumnWidths
End With
Sheets("Calculations").Range("A1:L1000").Copy
With Sheets("Calculations Final").Range("iv1").End(xlToLeft).Offset(, 1)
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteColumnWidths
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Suggestion below.
Also I would avoid Option Base 1 - it's rarely used, and will just cause problems later when you get used to working with zero-based arrays.
Sub Print_copy_Current_Workbook()
Dim Tabs As Variant
Dim I As Long
Application.ScreenUpdating = False
Tabs = Array("Draw", "AIN", "Calculations")
For I = LBound(Tabs) To UBound(Tabs)
Sheets(Tabs(I)).PrintOut
Sheets.Add(After:=Sheets(Worksheets.Count)).Name = Tabs(I) & " Final"
CopyPaste Sheets(Tabs(I)).Range("A1:L1000")
Next I
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Sub CopyPaste(rng As Range)
rng.Copy
'this is a new sheet we're pasting to, so why not just Range("A1") ?
With Sheets(rng.Parent.Name & " Final").Range("iv1").End(xlToLeft).Offset(, 1)
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteColumnWidths
End With
End Sub
Is it possible to copy format of one excel sheet to another worksheet using VBA.
Like manually we can do by selecting entire sheet and then click on format button. And then select other worksheet and format will be copied. Is it possible to do by code.
Thanks & Regards
Sahil Chaudhary
Absolutely. Below is sample code.
see https://msdn.microsoft.com/en-us/library/office/ff837425.aspx
Sub Wsh_PasteSpecial()
Dim WshSrc As Worksheet
Dim WshTrg As Worksheet
Rem Set working worksheets
Set WshSrc = ThisWorkbook.Worksheets("Source")
Set WshTrg = ThisWorkbook.Worksheets("Target")
WshSrc.Cells.Copy
With WshTrg.Cells
.PasteSpecial Paste:=xlPasteColumnWidths
.PasteSpecial Paste:=xlPasteFormats
.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
Application.CutCopyMode = False
End With
End Sub
Find below the full code to paste the format of one Worksheet named "Source", including Color, ColumnWidth, RowHeight, Comment, DataValidation, except the contents (Values, Formulas) of the cells to all other Worksheets in the same Workbook excluding a List of Worksheets as an Array
Option Explicit
Sub Wsh_PasteSpecial_Test()
Dim aWshExcluded As Variant, vWshExc As Variant
aWshExcluded = Array("Exclude(1)", "Exclude(2)")
Dim WshSrc As Worksheet
Dim WshTrg As Worksheet
Rem Set Source Worksheet
Set WshSrc = ThisWorkbook.Worksheets("Source")
Application.ScreenUpdating = 0
Rem Process All Worksheets
For Each WshTrg In WshSrc.Parent.Worksheets
Rem Exclude Worksheet Source
If WshTrg.Name <> WshSrc.Name Then
Rem Validate Worksheet vs Exclusion List
For Each vWshExc In aWshExcluded
If WshTrg.Name = vWshExc Then GoTo NEXT_WshTrg
Next
Rem Process Worksheet Target
With WshTrg.Cells
WshSrc.Cells.Copy
.PasteSpecial Paste:=xlPasteFormats 'Source format is pasted.
.PasteSpecial Paste:=xlPasteComments 'Comments are pasted.
.PasteSpecial Paste:=xlPasteValidation 'Validations are pasted.
Application.CutCopyMode = False
Application.Goto .Cells(1), 1
End With: End If:
NEXT_WshTrg:
Next
Application.Goto WshSrc.Cells(1), 1
Application.ScreenUpdating = 1
End Sub