I asked a question about this piece of code yesterday but this is part two. Once the identified sheets have detached from the original workbook, they maintain all of their formulas (xlPasteValuesAndNumberFormats). There are two sheets in particular, "REQUESTOR" and "Copy", that am only needing the values for but the other 3 sheets need to bring their formulas along during the detachment. The reason is because those 2 sheets contain external referencing formulas while the other 3 do not. How do I get all of the sheets to detach into a new work book and make the 2 identified sheets be values only while the other 3 carry all of their formulas into the new workbook?
Private Sub CommandButton1_Click()
' Plain_Copy Macro
Sheets("PROCUREMENT").Visible = True
Sheets("Request").Visible = True
Sheets("LISTS").Visible = True
Sheets("Copy").Visible = True
Dim TheActiveWindow As Window
Dim TempWindow As Window
Dim ws As Worksheet
With ActiveWorkbook
.Sheets(Array("REQUESTOR", "PROCUREMENT", "Request", "LISTS", "Copy")).Copy
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets
With ws.UsedRange
.Copy
.PasteSpecial xlPasteValuesAndNumberFormats
End With
TempWindow.Close
Next ws
Application.CutCopyMode = False
Application.ScreenUpdating = True
End With
Avoid any potential problems with nesting With ActiveWorkbook for both the original and the copy by assigning them to variables and then it is clear which is being processed.
Option Explicit
Private Sub CommandButton1_Click()
' Plain_Copy Macro
Dim wb As Workbook, wbCopy As Workbook
Dim ws As Worksheet, ar, v
ar = Array("REQUESTOR", "PROCUREMENT", "Request", "LISTS", "Copy")
Application.ScreenUpdating = False
Set wb = ActiveWorkbook
With wb
For Each v In ar
.Sheets(v).Visible = True
Next
.Sheets(ar).Copy
Set wbCopy = ActiveWorkbook
End With
For Each ws In wbCopy.Worksheets
If ws.name = "REQUESTOR" Or ws.name = "Copy" Then
With ws.UsedRange
' replace formula with values
.Value2 = .Value2
End With
End If
Next
Application.ScreenUpdating = True
MsgBox "Copy is " & wbCopy.name
End Sub
Related
I am trying to create a macro that copies the values of multiple worksheets (all but the first one) from an active workbook into a new workbook for which I have put the path in cell F21 of sheet1.
Below is a code that enables me to do so for sheet2. But I can't seem to find how to adapt it so that it does it for sheets 2, 3, 4, 5, 6, 7, 8, and 9.
Another interesting thing to note is that sheet8 contains pivot tables, and it seems to be an issue when copying it to another worksheet.
Do you have any idea how I could do that ?
(By the way if you have an idea how to do it, but sheet1 is included in the new file, it is not that much of a problem)
Thanks a lot.
Sub export()
Dim SourceBook As Workbook, DestBook As Workbook, SourceSheet As Worksheet, DestSheet As Worksheet
Dim SavePath As String, i As Integer
Application.ScreenUpdating = False
Set SourceBook = ThisWorkbook
SavePath = Sheets("Sheet1").Range("F21").Text
Set SourceSheet = SourceBook.Sheets("Sheet2")
Set DestBook = Workbooks.Add
Set DestSheet = DestBook.Worksheets.Add
Application.DisplayAlerts = False
For i = DestBook.Worksheets.Count To 2 Step -1
DestBook.Worksheets(i).Delete
Next i
Application.DisplayAlerts = True
SourceSheet.Cells.Copy
With DestSheet.Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats 'Delete if you don't want formats copied
End With
DestSheet.Name = SourceSheet.Name
DestBook.Activate
With ActiveWindow
.DisplayGridlines = False
.DisplayWorkbookTabs = False
End With
SourceBook.Activate
Application.DisplayAlerts = False 'Delete if you want overwrite warning
DestBook.SaveAs Filename:=SavePath
Application.DisplayAlerts = True 'Delete if you delete other line
SavePath = DestBook.FullName
DestBook.Close 'Delete if you want to leave copy open
MsgBox ("A copy has been saved to " & SavePath)
End Sub
I strongly encourage you to look into the following topics. I have included a couple of links to get you started.
Passing arguments to procedures (https://www.homeandlearn.org/passing_values_to_a_sub.html)
Parameters and arguments (https://stackoverflow.com/questions/156767/whats-the-difference-between-an-argument-and-a-parameter#:~:text=Generally%20speaking%2C%20the%20terms%20parameter,function%20when%20it%20is%20called.)
Modular Programming (https://en.wikipedia.org/wiki/Modular_programming)
The code below passes arguments and loops through all of the worksheets. This setup allows you to copy any number of (contiguous) sheets by changing the values of the iSheetStart and iSheetEnd arguments in the DoExport procedure. Because the logic has been abstracted and split up into a more modular form, it is generic enough that you can use the same code over and over again without re-writing the code every time. Some of this logic can be split up further into more procedures as well.
You could also abstract the code further by changing all of the situations where you have "Delete if..." comments to procedure parameters. You can also make SavePath, SourceBook, Destbook, etc. parameters.
I also encourage you to look at the Worksheets.Copy method (https://learn.microsoft.com/en-us/office/vba/api/excel.worksheet.copy). This may be faster than what you're currently doing, although all I don't believe there's an option to exclude formatting.
The procedure that you should run is DoExport. All other procedures will be called by it.
Option Explicit
Sub DoExport()
Export iStartSheet:=2, iEndSheet:=9
End Sub
Sub Export(iStartSheet As Integer, iEndSheet As Integer)
Dim SourceBook As Workbook: Set SourceBook = ThisWorkbook
Dim SavePath As String: SavePath = SourceBook.Sheets("Sheet1").Range("F21").Text
Dim DestBook As Workbook: Set DestBook = Workbooks.Add
Dim iSheetNum As Integer
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
For iSheetNum = iStartSheet To iEndSheet
CopySheet SourceBook, DestBook, iSheetNum
Next iSheetNum
DestBook.Activate
With ActiveWindow
.DisplayGridlines = False
.DisplayWorkbookTabs = False
End With
DestBook.SaveAs Filename:=SavePath
With Application
.DisplayAlerts = False 'Delete if you want overwrite warning
.DisplayAlerts = True 'Delete if you delete other line
End With
DestBook.Close 'Delete if you want to leave copy open
MsgBox ("A copy has been saved to " & SavePath)
End Sub
Sub CopySheet(SourceBook As Workbook, ByRef DestBook As Workbook, iSheetNum As Integer)
Dim SourceSheet As Worksheet
Dim DestSheet As Worksheet
With DestBook.Sheets
Set DestSheet = IIf(.Count < iSheetNum, _
.Add(After:=DestBook.Sheets(.Count)), _
DestBook.Sheets(iSheetNum))
End With
Set SourceSheet = SourceBook.Sheets(iSheetNum)
SourceSheet.Cells.Copy
With DestSheet
With .Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats 'Delete if you don't want formats copied
End With
.Name = SourceSheet.Name
End With
End Sub
I'm new to VBA and I'm working on a project. I've searched around the internet and managed to put something together using others' examples. The basic idea is that the code copies user-selected data to a single master workbook. This is what I have so far;
Sub SelectOpenCopy()
Dim vaFiles As Variant
Dim i As Long
Dim DataBook As Workbook
Dim DataSheet As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
vaFiles = Application.GetOpenFilename(Title:="Select files", MultiSelect:=True)
If IsArray(vaFiles) Then
For i = LBound(vaFiles) To UBound(vaFiles)
Set DataBook = Workbooks.Open(FileName:=vaFiles(i))
For Each DataSheet In ActiveWorkbook.Sheets
DataSheet.Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
Next DataSheet
DataBook.Close savechanges:=False
Next i
End If
End Sub
Two problems with this is that:
If I run the code again and select the same files, new worksheets are made in the master workbook and that isn't what I'm going for. If those worksheets already exist, I want them to be updated instead of new ones being made. If it helps to mention, all the workbooks that need to be copied to the master file only have one worksheet each and the worksheet name matches its workbook too.
The code copies all the data, but I only need a set range ("A1:L1000").
There's a lot I don't understand about VBA, so any and all help is really appreciated!
...
Const CopyAddress = "A1:L1000"
Dim MasterSheet As Worksheet, SheetName As String, SheetExists As Boolean
...
For Each DataSheet In DataBook.Worksheets
SheetName = DataSheet.Name
SheetExists = False
For Each MasterSheet In ThisWorkbook.Worksheets
If MasterSheet.Name = SheetName Then
SheetExists = True
Exit For
End If
Next MasterSheet
If SheetExists Then
DataSheet.Range(CopyAddress).Copy MasterSheet.Range(CopyAddress).Cells(1, 1)
Else
DataSheet.Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
End If
Next DataSheet
...
When you run it, don't forget to change the path for the target workbook.
Sub moveData()
'turn off unnecessary applications to make the macro run faster
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Dim target_wb As Workbook
Dim main_wb As Workbook
Dim file_sheet As Worksheet
Dim exists As Boolean
Dim next_empty_row As Long
Dim R As Range
Dim sheet_name As String
Set main_wb = ThisWorkbook
Set R = _
Application.InputBox("please select the data range:", "Kutools for Excel", , , , , , 8)
sheet_name = ActiveSheet.Name
R.Select
Selection.copy
'workbook path to paste in
Set target_wb = _
Workbooks.Open("/Users/user/Desktop/target.xlsx")
For Each file_sheet In target_wb.Sheets
Application.DisplayAlerts = False
If file_sheet.Name = main_wb.ActiveSheet.Name Then
exists = True
Exit For
Else
exists = False
End If
Next file_sheet
If exists = False Then
target_wb.Sheets.Add.Name = sheet_name
End If
next_empty_row = _
target_wb.Sheets(sheet_name).Cells(Rows.Count, 1).End(xlUp).Row + 1
target_wb.Sheets(sheet_name).Cells(next_empty_row, 1).PasteSpecial
target_wb.Save
target_wb.Close
'turn on applications
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
End Sub
The code from this forum is what I used as a starting point. I am trying to modify it to copy multiple sheets and paste them all as values, instead of just one sheet.
I copied multiple sheets using worksheets(array(1,2,3)).copy. I think the problem is With ActiveSheet.UsedRange because it is only replacing the first sheet as values and leaving the remaining sheets as formulas.
What do I need to change so that all the sheets paste as values?
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = False
Worksheets(Array("Sheet 1","Sheet 2","Sheet 3").Copy
With ActiveSheet.UsedRange
.Value = .Value
End With
Set wbNew = ActiveWorkbook
wbNew.SaveAs "L:\Performance Data\UK Sales\Sales (Latest).xlsx"
wbNew.Close True
Application.DisplayAlerts = True
End Sub
You need to loop through the sheets:
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.UsedRange.Value = ws.UsedRange.Value
Next ws
So, with your code, you could do it like this:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim wbOld As Workbook, wbNew As Workbook
Dim ws As Worksheet, delWS As Worksheet
Dim i As Long, lastRow As Long, lastCol As Long
Dim shts() As Variant
Dim rng As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wbOld = ActiveWorkbook
shts() = Array("Sheet 1", "Sheet 2", "Sheet 3")
Set wbNew = Workbooks.Add
Set delWS = ActiveSheet
wbOld.Worksheets(Array("Sheet 1", "Sheet 2", "Sheet 3")).Copy wbNew.Worksheets(1)
delWS.Delete
For i = LBound(shts) To UBound(shts)
With wbNew.Worksheets(shts(i))
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set rng = .Range(.Cells(1, 1), .Cells(lastRow, lastCol))
rng.Value = rng.Value
End With
Next i
wbNew.SaveAs "L:\Performance Data\UK Sales\Sales (Latest).xlsx"
wbNew.Close True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Note: I am not sure which workbook you want to paste the values in. As it is above, it does this in the COPIED workbook, not original.
My workbook has both chart sheets and normal sheets, therefore I am using Sheets instead of Worksheets. However, I don't know what the type of sht should be in the following set of codes. I am sure it cannot be Worksheet.
' Hide all sheets/charts except Sheet1
Sub Hide_Sheets()
Dim sht As ???
For Each sht In ActiveWorkbook.Sheets
If sht.Name <> Sheet3.Name Then
sht.Visible = False
End If
Next sht
End Sub
"Charts and Worksheets are two different collections." --> https://stackoverflow.com/a/6804704/138938
If you have both chart sheets and regular worksheets, you can either loop through a collection of objects like this:
Sub Hide_Objects()
Dim wb As Workbook
Dim obj As Object
Set wb = ActiveWorkbook
For Each obj In wb.Sheets
If obj.Name <> "Sheet1" Then
obj.Visible = False
End If
Next obj
End Sub
Or you can loop through both collections like this:
Sub Hide_Sheets_And_Charts()
Dim wb As Workbook
Dim sht As Worksheet
Dim cht As Chart
Set wb = ActiveWorkbook
For Each sht In wb.Worksheets
If sht.Name <> "Sheet1" Then
sht.Visible = False
End If
Next sht
For Each cht In wb.Charts
If cht.Name <> "Sheet1" Then
cht.Visible = False
End If
Next cht
End Sub
Use Variant then step through the code and you'll be able to see what it is.
Variant will work without doing anything else.
I recommend using real names for variables to make it easier for you to read your code at some stage in the future.
Sub Hide_Sheets()
Dim sheet_ As Variant
For Each sheet_ In ActiveWorkbook.Sheets
If sheet_.Name <> Sheet3.Name Then
sheet_.Visible = False
End If
Next sheet_
End Sub
I am wanting to have a button open a userform with a list of all open Workbooks. The user selects the workbook they want and the code copies data from a fixed range in the current workbook and pastes it into a fixed range in the user selected workbook.
While searching around I found this code, that works similarly but copies from the selected workbook and pastes into the current one.
Option Explicit
Const PSWD = "atari"
Private Sub CancelButton_Click()
Unload Me
End Sub
Private Sub CopyPasteButton_Click()
ActiveSheet.Unprotect Password:=PSWD
'This code will be executed when the "Copy" button is clicked on the userform.
Dim wsData As Worksheet
Dim rCopy As Range
Dim CopyRw As Long
Set wsData = ThisWorkbook.Sheets("SALES Details")
With Application
.DisplayAlerts = False
.ScreenUpdating = True
With wsData
.Unprotect PSWD
CopyRw = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
End With
On Error GoTo exit_err
With Workbooks(Me.ListBox1.Value).Sheets("Master Sheet")
Set rCopy = .Cells(10, 1).CurrentRegion
Set rCopy = rCopy.Offset(1, 0).Resize(rCopy.Rows.Count - 1, 40)
rCopy.Copy ThisWorkbook.Sheets("SALES Details").Cells(CopyRw, 1)
End With
Unload Me
exit_err:
wsData.Protect Password:=PSWD
.DisplayAlerts = True
.ScreenUpdating = True
.CutCopyMode = False
End With
End Sub
Private Sub UserForm_Activate()
'Populate list box with names of open workbooks, excluding main workbook.
Dim wb As Workbook
For Each wb In Workbooks
If wb.Name <> ThisWorkbook.Name Then ListBox1.AddItem wb.Name
Next wb
End Sub
This code works great, for what it does. I have been trying to edit it without luck. How can I edit this to reverse the direction and have it copy from a fixed range in the current sheet (A50:J57) to a fixed range on the user selected sheet (A4:J11)?
I think this should work. Of course you have to adapt the sheet names in code.
Private Sub CopyPasteButton_Click()
Dim mySheet As Worksheet, otherSheet As Worksheet
On Error GoTo exit_err
Application.DisplayAlerts = False
Set mySheet = ThisWorkbook.Sheets("SheetXYZ")
Set otherSheet = Workbooks(Me.ListBox1.Value).Sheets("SheetABC")
mySheet.Range("A50:J57").Copy Destination:=otherSheet.Range("A4:J11")
exit_err:
Application.DisplayAlerts = True
End Sub
UPDATE
For copying the values and not the formulas of the range use this code instead of the Copy function:
mySheet.Range("A50:J57").Copy
otherSheet.Range("A4:J11").PasteSpecial xlPasteValuesAndNumberFormats
For further options of the PasteSpecial function see the documentation.