I am trying to create a macro that dublicates and renames a dashboard, but doesn't include references to other worksheets. So basically i need it to insert charts as "pictures" and cells as values.
Until now, I have finished the duplication, but it still refers back to other worksheets and hence change correspondingly to the original dashboard.
Here is my code so far:
Sub CopySheet()
Dim i As Integer, x As Integer
Dim shtname As String
i = Application.InputBox("How many copies of this dashboard do you need?", "Copy sheet", Type:=1)
For x = 0 To i - 1
Worksheets("Dashboard").Copy After:=Sheets(Sheets.Count)
shtname = InputBox("What do you want to name your new dashboard?")
ActiveSheet.Name = shtname
Next x
End Sub
if i understood your question you can try this example code where you get an picture as image and value without formula:
sub test()
Dim sPath As String, sFile As String
Dim wb As Workbook
sPath = "yourPath\"
sFile = sPath & "yuorFile.xlsx"
Set wb = Workbooks.Open(sFile)
Range("A1:B8").Select ' select my value range
Selection.Copy 'copy it
Windows("NameFileDestination").Activate 'destination copy value
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("yuorFile.xlsx").Activate 'active source file where there is the chart
ActiveSheet.ChartObjects("Graphic name").Activate
Application.CutCopyMode = False
ActiveChart.ChartArea.Copy ' copy chart like image
Windows("NameFileDestination").Activate
Range("D2").Select
'below there is in italian immagine change in image
ActiveSheet.PasteSpecial Format:="Immagine (PNG)", Link:=False, _
DisplayAsIcon:=False
ActiveWorkbook.Save
wb.Close
end sub
Hope this helps
Related
I am trying to copy from a macro enabled workbook to a .csv file, but for some reason the paste part paste everything in Column A only. VBA coding is below. Please help me figure out why it will not paste into the same cells as it copies. When I run the macro step by step it works perfect, however when it runs by itself it paste all data in Column A.
Sheets("Input").Select
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Workbooks.Open Filename:="C:\temp\MyFile.csv"
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Export Worksheet to CSV
An Alternative
If whatever you are trying to select is the only data in the worksheet, you can just copy the worksheet, which creates a new workbook containing only this worksheet and finally save it as a CSV file.
Option Explicit
Sub ExportWorksheetToCSVtest()
Const FilePath As String = "C:\temp\MyFile.csv"
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Input")
ExportWorksheetToCSV ws, FilePath
End Sub
Sub ExportWorksheetToCSV( _
ByVal ws As Worksheet, _
ByVal FilePath As String)
If ws Is Nothing Then Exit Sub
ws.Copy
With ActiveWorkbook
Application.DisplayAlerts = False
.SaveAs FilePath, xlCSV
Application.DisplayAlerts = True
.Close SaveChanges:=False
End With
End Sub
Updated with improved answer.
Not sure what you're doing wrong with your sheet, but this will work. Don't use Select.
Dim CopyRange As Range, copySheet As Worksheet
Set copySheet = ActiveSheet
Set CopyRange = Intersect(Range("A:C"), copySheet.UsedRange)
Dim theValues()
theValues = CopyRange.Value
Workbooks.Open Filename:="C:\temp\MyFile.csv"
Dim theCSV As Workbook
Set theCSV = ActiveWorkbook
theCSV.Sheets(1).Range("A1").Resize(UBound(theValues), UBound(theValues, 2)) = theValues
#PGSystemTester: This code did the same thing. Everything is pasted in Column A only.
#VBasic2008: This worked, but also gave unexpected errors.
What I did to make it work was basically run the same macro twice. I am not sure why this works. But the first time the macro runs, it pastes everything in Column A. When it runs again, it pastes correctly. So I just doubled the coding for the macro and now it works fine.
Thanks for the help!
good people, I hope you have a nice day. I am new to Excel Macro VBA here. I need to build Excel Macro Enabled Workbook for specific data processing.
Background: I am trying to copy data as values from every sheet from "source" workbook to a table in my master workbook, then when every data on every sheet has been copied, I need to remove duplicates from that table in my master workbook.
Problem: The number of sheets in "source" workbook is uncertain.
Goal: To copy from every sheet in "source" workbook, stacked in my master workbook then remove duplicates in my master workbook.
I provided my set of code for single sheet "source" workbook, please help me achieve my goal. I tried using do while loop, do until loop but they failed to execute my code
Sub Copy_SourceToMaster()
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
OpenBook.Sheets(1).Activate
Range("C6").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
ThisWorkbook.Activate
ActiveSheet.Range("B4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
OpenBook.Close False
End If
Application.ScreenUpdating = True
Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Set sht = ActiveSheet
Set StartCell = Range("B5")
'Find Last Row and Column
LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column
'Select Range
sht.Range(StartCell, sht.Cells(LastRow, LastColumn)).Select
Selection.RemoveDuplicates Columns:=2, Header:= _
xlYes
Range("B5").Select
Selection.End(xlDown).Select
End Sub
In order to count the worksheets in a workbook, you can simply use this:
Whatever_Workbook.Sheets.Count
In top of this, in your code you're doing quite some copy-paste, you can heavily simplify this using destination_range.Value = source_range.Value inside a for-loop. (See How to avoid using Select in Excel VBA for more information)
Trying to get a macro that prompts a user to open an xlsm file, go to a specific tab, unhide the columns and turn off the filters, select all the data and paste into a new tab called RRImport.
Example: Working in a file called MergedData.xlsm, run macro to Open Jul01Data.xlsm, select "Reviewed Data" tab in Jul01Data.xlsm, unhide all columns and turn off all filters in the "Reviewed Data" tab, copy all data, Make a New sheet in MergedData.xlsm called "RRImport" and paste-special-values all the data in cell A1 of "RRImport". Close Jul01Data.xlsm without saving any changes to it
Sub ImportSheet()
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "RRImport"
Sheets("RRImport").Select
Application.DisplayAlerts = False
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Set wb1 = ActiveWorkbook
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Report to Append to Merged Data", _
FileFilter:="Report Files *.xlsm (*.xlsm),")
If FileToOpen = False Then
MsgBox "No File Specified.", vbExclamation, "ERROR"
Exit Sub
Else
Set wb2 = Workbooks.Open(Filename:=FileToOpen)
End If
wb2.Sheets("Reviewed Data").Select
' HERE IS WHERE I GET THE ERROR, IR WON'T UNHIDE THE FILTERS
If wb2.AutoFilterMode Then
wb2.AutoFilterMode = False
End If
Columns("A:M").Select
Selection.Copy
wb1.Sheets("RRImport").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wb2.Close
End Sub
It should work Now:
AutoFilterMode is a Worksheet Property not Workbook Property.
Sub ImportSheet()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Set wb1 = ActiveWorkbook
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Report to Append to Merged Data", _
FileFilter:="Report Files *.xlsm (*.xlsm),")
If FileToOpen = False Then
MsgBox "No File Specified.", vbExclamation, "ERROR"
Exit Sub
Else
Set wb2 = Workbooks.Open(filename:=FileToOpen)
End If
If wb2.Sheets("Reviewed Data").AutoFilterMode Then
wb2.Sheets("Reviewed Data").AutoFilterMode = False
End If
Dim ws As Worksheet
wb1.Activate
Set ws = wb1.Worksheets.Add(, ActiveSheet)
ws.Name = "RRImport"
wb2.Sheets("Reviewed Data").Columns("A:M").Copy
ws.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wb2.Close False
End Sub
I have made few other changes also.
So as this worked, I'll add the explanation.
First, you selected the worksheet, but then your code goes on while you're referring to the whole workbook, and not the worksheet.
That means, you don't need to select the worksheet, just refer to it same as you referred to the workbook.
What if instead
wb2.Sheets("Reviewed Data").Select
' HERE IS WHERE I GET THE ERROR, IR WON'T UNHIDE THE FILTERS
If wb2.AutoFilterMode Then
wb2.AutoFilterMode = False
End If
You wrote
If wb2.Sheets("Reviewed Data").AutoFilterMode Then
wb2.Sheets("Reviewed Data").AutoFilterMode = False
End If
I need help in achieving the below in my excel sheet with one master MACRO VBA Code
If column A contains 0 - Delete the entire row. ( Row Killer ) - This should run on all the sheets in the workbook
Since the excel file is heavily linked - All fields needs to converted to values (E.g. Paste as Values)
Save AS file in .xls format with the file name SAMAmonthlyReport
I have the code for point 2 and 3 from this site but need help in adding the 1 point.
Below is the code
Sub CopyValuesToSync()
Dim OrigWkbkFpth As String
Dim OrigWkbk As String
Dim ValueWkbk As String
Dim WS As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
OrigWkbkFpth = Application.ActiveWorkbook.FullName
OrigWkbk = Application.ActiveWorkbook.Name
For Each WS In ActiveWorkbook.Worksheets
WS.Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
Next WS
ActiveWorkbook.SaveAs Filename:="C:\SAMA\SamaMonthly.xls", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ValueWkbk = Application.ActiveWorkbook.Name
Workbooks.Open Filename:=OrigWkbkFpth
Windows(ValueWkbk).Activate
ActiveWindow.Close
Windows(OrigWkbk).Activate
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
You can add a validation for each cell in column A using something like If cells(oRow,1).Value = 0 Then and then you can delete the Row with
Rows(oRow).EntireRow.Delete
in the main workbook I start a button that opens the second workbook, then go back to first workbook, copy a range of cells, then go to the second workbook (here it goes wrong) to paste
Sub Knop7_Klikken()
Dim TelStaat As Workbook
Dim Staat As Worksheet
Dim WicamStaat As Workbook
Dim Invoer As Worksheet
Dim Pathname As String
Dim Filename As String
Dim Value1 As String
'TelStaat = "Calculatie 2014 Nesting Wicam.xlsm"
Set TelStaat = ThisWorkbook
Value1 = "AN"
Pathname = "V:\\2013 Calculatie\"
Filename = "VPT.xlsm"
'when I use this it wil not open second macro
Application.EnableEvents = False
Workbooks.Open Filename:=Pathname & Filename
Worksheets("Invoer").Activate
TelStaat.Activate
Worksheets("Staat").Columns(3).Find(Value1).Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.Offset(0, 6).Select
Selection.Resize(, 6).Select
Selection.Copy
'here it goes wrong,
Set WicamStaat = ActiveWorkbook
Worksheets("Invoer").Activate
Range("A32").Select
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.Calculation = True / xlAutomatic
End Sub
Windows("copyfromfile.xlsx").Activate 'Copy
Columns("A:H").Select
Selection.Copy
Windows("pastetofile.xlsx").Activate 'Paste
Columns("A:A").Select
Selection.Insert Shift:=xlToRight