I built a code into a command button that identified a single sheet, copies the values and the formulas, and creates a separate detached workbook that we use for ordering material. The original formula worked great and was simple when there was only 1 target sheet. I have added 4 additional sheets to be captured, the core of the formula still works and it copies/detaches a separate workbook for ordering, but now it is also creating a copy of the original workbook as well for no reason.
How can I get it to only copy and detach the sheets in the formula and not the entire 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
Set TheActiveWindow = ActiveWindow
Set TempWindow = .NewWindow
.Sheets(Array("REQUESTOR", "PROCUREMENT", "Request", "LISTS", "Copy")).Copy
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets
With ws.UsedRange
.Copy
.PasteSpecial xlPasteFormulasAndNumberFormats
End With
TempWindow.Close
Next ws
Application.CutCopyMode = False
Application.ScreenUpdating = True
End With
Related
I have the following code
Sub Workbook_Open()
Dim x As Workbook
Dim y As Workbook
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Application.AlertBeforeOverwriting = False
Set x = ThisWorkbook
Set y = Workbooks.Open("N:\\REAL PATH")
'Opens Data and Pastes Values
x.Worksheets("Event Data").Range("Table1[#All]").Copy
y.Worksheets("CoreData").Range("A1").PasteSpecial Paste:=xlPasteValues
x.Worksheets("Comments").Range("Table2[#All]").Copy
y.Worksheets("CommentsData").Range("A1").PasteSpecial Paste:=xlPasteValues
x.Worksheets("Match Data").Range("Table3[#All]").Copy
y.Worksheets("MatchDetails").Range("A1").PasteSpecial Paste:=xlPasteValues
y.Close SaveChanges:=True
ActiveWorkbook.Save
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
After running the code, I go to the workbook named y, and I find that Table 1's data has been pasted three times. So, basically, the y.Worksheets lines are working properly but it won't copy data from Table 2 or 3. If I hit ctrl + g and type in "Table2[#All]" I am taken to the full Table 2, so I know that the range exists and that VBA should be able to find it. Table 1 contains quite a bit of data (131k rows + columns to DZ), but I don't know if that's relevant.
I find that creating and using intermediate variables greatly helps to clear up any problems in transferring data. Plus, you can look at these variables when debugging to verify they are correctly set.
Try something along these lines:
Option Explicit
Sub Example()
Dim srcWB As Workbook
Dim dstWB As Workbook
Set srcWB = ThisWorkbook
Set dstWB = Workbooks.Open("N:\\REAL PATH")
Dim srcData As Range
Dim dstData As Range
Set srcData = srcWB.Sheets("Event Data").Range("Table1[#All]")
Set dstData = dstWB.Sheets("CoreData").Range("A1").Resize(srcData.Rows.Count, _
srcData.Columns.Count)
dstData.Value = srcData.Value
Set srcData = srcWB.Sheets("Comments").Range("Table2[#All]")
Set dstData = dstWB.Sheets("CommentsData").Range("A1").Resize(srcData.Rows.Count, _
srcData.Columns.Count)
dstData.Value = srcData.Value
Set srcData = srcWB.Sheets("Match Data").Range("Table3[#All]")
Set dstData = dstWB.Sheets("MatchDetails").Range("A1").Resize(srcData.Rows.Count, _
srcData.Columns.Count)
dstData.Value = srcData.Value
dstWB.Close SaveChanges:=True
End Sub
You've also confused using ThisWorkbook and later using ActiveWorkbook. It's not clear which on you're saving.
This type of "value only" data copy is very fast, and you may not need to disable events or screen updates. You still may need to disable these if you also have event handlers catching worksheet changes.
I am using an excel Workbook for programtical generation. Once the workbook is created few of the sheets are having required data and few are blank with default templates only.
I need to delete all sheets having default templates (means no data). I can check specific cell to identify this however need to know how to check for all sheets and then delete sheets one by one.
I am having this piece of code:
Sub TestCellA1()
'Test if the value is cell D22 is blank/empty
If IsEmpty(Range("D22").Value) = True Then
MsgBox "Cell A1 is empty"
End If
End Sub
Try this:
Sub DeleteEmptySheets()
Dim i As Long, ws As Worksheet
' we don't want alerts about confirmation of deleting of worksheet
Application.DisplayAlerts = False
For i = Worksheets.Count To 1 Step -1
Set ws = Worksheets(i)
' check if cell D22 is empty
If IsEmpty(ws.Range("D22")) Then
Sheets(i).Delete
End If
Next
' turn alerts back on
Application.DisplayAlerts = True
End Sub
An alternative implementation using For-Each:
Sub deleteSheets()
Dim wb As Workbook
Dim sht As Worksheet
Set wb = Workbooks("Name of your Workbook")
'Set wb = ThisWorkbook You can use this if the code is in the workbook you want to work with
Application.DisplayAlerts = False 'skip the warning message, the sheets will be deleted without confirmation by the user.
For Each sht In wb.Worksheets
If IsEmpty(sht.Range("D22")) And wb.Worksheets.Count > 1 then
sht.Delete
End If
Next sht
Application.DisplayAlerts = True
End Sub
This mainly serves as a demonstration pf how you can easily loop through worksheets.
As suggested in the comments below by #Darren Bartrup-Cook , the logic according to which the sheets are deleted can and should be modified to not only suit your purposes but to also include safeguards.
Making sure there's always at least one worksheet in the workbook is one of them. This can be ensured in a multitude of ways. I updated my answer to implement one these.
I have a simple macro that opens a csv file and supposed to copy a cell in the working Workbook:
Sub macro1()
Dim build_w As Workbook
Dim build_s As Worksheet
Dim folder_st As String
Application.ScreenUpdating = False
folder_st = "c:\file.csv"
Set build_w = Application.Workbooks.Open(folder_st)
Set build_s = build_w.Sheets("build")
build_s.Range("A1").Copy
ActiveSheet.Paste Range("A284")
build_w.Close True
Application.ScreenUpdating = True
End Sub
If I comment out the line build_s.Range("A1").Copy everything is fine, but If I leave this in, Excel crashes every single time.
Any suggestions?
Are you aware that the ActiveSheet at the moment you paste is itself the build_s worksheet? This is the problem when working with stuff like Activesheet. It is always preferable to specify worksheet and workbook objects precisely, without counting on what is active at a given moment.
Eventually, to get the behavior you want, you should do:
build_s.Range("A1").Copy ThisWorkbook.ActiveSheet.Range("A284")
Have you tried handling any possible errors with:
On Error GoTo MyHandler
MyHandler:
PFB for the require code. CSV file cannot have multiple sheets so that's why it must be crashing. CSV files can have only one sheet in it, so no need to specify sheet name.
Sub macro1()
'Declared variables
Dim build_w As Workbook
Dim folder_st As String
'Disabling screen updates
Application.ScreenUpdating = False
'Initializing the file name
folder_st = "c:\file.csv"
'Opening the workbook
Set build_w = Workbooks.Open(folder_st)
'Copying the value of cell A1
Range("A1").Copy
'Selecting the cell A284
Range("A284").Select
'Pasting the copied value
ActiveSheet.Paste
'Saving the workbook by saving the .CSV file
build_w.Close True
'Enabling screen updates
Application.ScreenUpdating = True
End Sub
it's because upon opening csv file it becomes the Active workbook and its only worksheet the Active worksheet
you can exploit this at your advantage like follows:
Option Explicit
Sub macro1()
Dim folder_st As String
Application.ScreenUpdating = False
folder_st = "c:\file.csv"
With ActiveSheet '<--| reference your currently active sheet before opening csv file
Application.Workbooks.Open(folder_st).Sheets("build").Range("A1").Copy '<--| open csv file (and it becomes the Active Workbook) and reference its "build" sheet range "A1" and copy it...
.Range("A284").PasteSpecial '<--| paste it to your referenced sheet range A284
Application.CutCopyMode = False '<--| release clipboard
ActiveWorkbook.Close False '<--| close Active workbook, i.e. the csv file
End With
Application.ScreenUpdating = True
End Sub
Good day
I am trying to run a very simple code, where I open a workbook, copy column "a:a", open another workbook and paste it there. The issue i am facing is that the data is being copied from the second workbook into the second workbook, nothing is being copied from the first.
Code below for more clarity
Sub Copytocurrent()
strSecondFile = "Z:\AR\AR PROGRESS\2014\MENACA REPORTS\0MENACA Working File\AR Working File\UAE\RECEIVABLE.xls"
strThirdFile = "Z:\AR\AR PROGRESS\2014\MENACA REPORTS\0MENACA Working File\AR Working File\UAE\Working File - UAE.xlsx"
Set wbk2 = Workbooks.Open(strSecondFile)
Set wbk3 = Workbooks.Open(strThirdFile)
'-------------------------------------------------------'
'Copy column A in Receivable to Column XB in Working File'
'-------------------------------------------------------'
Application.CutCopyMode = False
wbk2.Sheets("receivable").Activate
With wbk2.Sheets("receivable")
Range("a:a").Copy
End With
wbk3.Sheets("Sheet1").Activate
With wbk3.Sheets("sheet1")
Range("XB1").PasteSpecial
End With
'-------------------------------------------------------'
'Copy column B in Receivable to Column XA in Working File'
'-------------------------------------------------------'
Application.CutCopyMode = False
wbk2.Sheets("receivable").Activate
With wbk2.Sheets("receivable")
Range("b:b").Copy
End With
wbk3.Sheets("Sheet1").Activate
With wbk3.Sheets("sheet1")
Range("XA1").PasteSpecial
End With
wbk2.Close True
wbk3.Close True
End Sub
Try this, activate Workbook objects accordingly like you would do in a real copypaste flow. I run this method in a third xlsm workbook.
Public Sub testCopy()
Dim wb1 As Workbook
Dim wb2 As Workbook
Set wb1 = Workbooks.Open("C:\projects\excel\book1.xlsx")
Set wb2 = Workbooks.Open("C:\projects\excel\book2.xlsx")
Application.CutCopyMode = False
wb1.Activate
With wb1.Sheets("Sheet1")
Range("A:A").Copy
End With
wb2.Activate
With wb2.Sheets("Sheet1")
Range("E1").PasteSpecial
End With
Application.CutCopyMode = False
wb1.Activate
With wb1.Sheets("Sheet1")
Range("B:B").Copy
End With
wb2.Activate
With wb2.Sheets("Sheet1")
Range("F1").PasteSpecial
End With
wb1.Close True
wb2.Close True
End Sub
edit: ok I was late you discovered the same fix by yourself a second before my post.
As you already identified, you're issue was that you're using the activeworkbook for the copying, but forget to use .Activate. Better than using ActiveWorkbook, try accessing the ranges directly. This makes the code more robust - and less bloated:
Sub CopyToCurrent()
Dim wbkSource As Workbook, wbkTarget As Workbook 'Alays Dim your variables to prevent errors from typos!
Dim wsSource As Worksheet, wsTarget As Worksheet
Application.ScreenUpdating = False 'Prevent screen flickering
Set wbkSource = Workbooks.Open("Z:\AR\AR PROGRESS\2014\MENACA REPORTS\0MENACA Working File\AR Working File\UAE\RECEIVABLE.xls")
Set wbkTarget = Workbooks.Open("Z:\AR\AR PROGRESS\2014\MENACA REPORTS\0MENACA Working File\AR Working File\UAE\Working File - UAE.xlsx")
Set wsSource = wbkSource.Sheets("receivable")
Set wsTarget = wbkTarget.Sheets("Sheet1")
wsSource.Range("A:A").Copy
wsTarget.Range("XB1").PasteSpecial
wsSource.Range("B:B").Copy
wsTarget.Range("XA1").PasteSpecial
wbkSource.Close False 'No need to save any changes
wbkTarget.Close True
Application.ScreenUpdating = True
End Sub
Note that I also added some small improvements (Dimming, prevent screenflickering)
I have a workbook I have been working on. This workbook has 3 sheets of information that help populate a MASTER sheet through excel index and match functions as well as other functions. The A2 cell on the MASTER sheet is a drop down box of names. As each name is chosen a macro linked to a button helps summarize the information and then an other button copies and paste the sheet to a new sheet in the workbook. My question is on the macro that summarizes the information. Being new to macros, I put this together with information gathered on the Internet. I noticed that it is hiding some rows when used which is not good and works really slow. Also, not of great important, it places the paste anywhere within the range. Even sometimes lines apart, like on E14 and E16 instead of E14 and E15. I am sure there is a better way of writing this macro and any help and education would be greatly appreciated.
Sub UniqueValues()
Dim ws As Worksheet
'list states for install & service
Application.ScreenUpdating = False
Set ws = Sheets("MASTER")
ws.Range("D94:D144").AdvancedFilter Action:=x1FilterInPlace, Unique:=True
Range("D94:D144").Copy
ws.Range("E14:E19").PasteSpecial x1Values
Application.CutCopyMode = False
Application.ScreenUpdating = True
'list states for overrides
Application.ScreenUpdating = False
Set ws = Sheets("MASTER")
ws.Range("D147:D246")AdvancedFilter Action:=x1FilterInPlace, Unique:=True
Range("D147:D246").Copy
ws.Range("E21:E26").PasteSpecial x1Values
Application.CutCopyMode = False
Application.ScreenUpdating = True
'lists states for licenses
Application.ScreenUpdating = False
Set ws = Sheets("MASTER")
ws.Range("D249:D298").AdvancedFilter Action:=x1FilterInPlace, Unique:=True
Range("D249:D298").Copy
ws.Range("E35:E38").PasteSpecial x1Values
Application.CutCopyMode = False
Application.ScreenUpdating = True
'lists states for commissions
Application.ScreenUpdating = False
Set ws = Sheets("MASTER")
ws.Range("D301:D327").AdvancedFilter Action:=x1FilterInPlace, Unique:=True
Range("D301:D327").Copy
ws.Range("E28:E33").PasteSpecial x1Values
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
The 'In Place' filter + copy paste will be very slow. If you want to improve your code you could use a Dictionary (available in the Microsoft Scripting Runtime)
Sub getUniquesValues(output As Range, cells As Range)
Dim cell As Range
Dim knownValues As New Dictionary
For Each cell In cells
If Not knownValues.Exists(cell.Value) Then
output = cell.Value
Set output = output.Offset(1, 0)
knownValues.Add cell.Value, 1
End If
Next
End Sub
Then all you have to do is call the sub this way :
Sub ImprovedUniqueValues()
Dim cell As Range, output As Range
Dim ws As Worksheet
Set ws = Sheets("MASTER")
Set output = ws.Range("E19")
getUniquesValues output, ws.Range("D94", ws.Range("D94").End(xlDown))
....
End Sub