Hi I am having 11 sheets in my workbook. I need to delete some contents in all the sheets except 1 sheet. I have written some code. while I am rund the code activesheet content will be deleted. rest of the contents not deleted. Please help on this. Here is my code
Sub ClearData()
Dim sheetsArray As Sheets
Set sheetsArray = ActiveWorkbook.Sheets(Array("Qns1", "Qns2", "Qns3", "Qns4", "Qns5", "Adl1", "Adl2", "Adl3", "Adl4", "Adl5"))
Dim sheetObject As Worksheet
' change value of range 'a1' on each sheet from sheetsArray
For Each sheetObject In sheetsArray
'Do something
Range("B2:C1000,E2:O1000").ClearContents
Next sheetObject
End Sub
Related
I have a plethora of Excel workbooks containing 25+ worksheets each containing 20 columns of data from range 1:500 (or 1:1000 in some cases). Frequently I am tasked with updating the "template" onto which new data is entered for new calculations. I want to be able to easily paste extant data from old worksheets into sheets with new formatting while retaining any new formatting/formulas in the new templates.
I am using VBA to open the sheet I want to copy and paste it onto the new template sheet. So far my code will copy everything from the first sheet (S1) of the to-be-copied workbook and paste it onto the first sheet (S1) of the target workbook.
I want to extend this process to go through all active sheets (do whatever it is doing now for each sheet in the workbooks). I previously was able to do this with different code but it removed the formulas in rows 503 and 506 that I need when it pasted in. Can I do a pastespecial and skip empty cells? I am new to this.
Here is my current code:
Sub CopyWS1()
Dim x As Workbook
Dim y As Workbook
Set x = Workbooks("Ch00 Avoid.xlsx")
Set y = Workbooks("Ch00 Avoid1.xlsx")
Dim LastRow As Long
Dim NextRow As Long
x.Worksheets("S1").Activate
Range("A65536").Select
ActiveCell.End(xlUp).Select
LastRow = ActiveCell.Row
Range("A2:T" & LastRow).Copy y.Worksheets("s1").Range("A1:A500")
Application.CutCopyMode = False
Range("A1").Select
End Sub
I believe that I need to use something like the following code in order to extend this across the worksheets, but I'm not sure how to iterate through the sheets since I'm specifically referencing two sheets in my above code.
Sub WorksheetLoop2()
' Declare Current as a worksheet object variable.
Dim Current As Worksheet
' Loop through all of the worksheets in the active workbook.
For Each Current In Worksheets
' Insert your code here.
' This line displays the worksheet name in a message box.
MsgBox Current.Name
Next
End Sub
I imagine that I might be able to solve this as a for loop across an index of worksheets (make a new variable and run a for loop until my index is 25 or something) as an alternative, but again, I'm not sure how to point my copy/paste from a particular sheet to another sheet. I am very new to this with semi-limited experience with Python/Java only. These VBA skills would greatly benefit me on the day to day.
The two files in question:
Ch00 Avoid
Ch00 Avoid1
This should do it. You should be able to drop this in a blank workbook just to see how it works (put some values in column A on a couple of sheets). Obviously you will replace your wbCopy and wbPaste variables, and remove the wbPaste.worksheets.add from the code (my excel was only adding 1 sheet in the new workbook). LastRow is determined per your code, looking up from column A to find the last cell. wsNameCode is used to determine the first part of your worksheets you are looking for, so you will change it to "s".
This will loop through all sheets in your copy workbook. For each of those sheets, it's going to loop 1 through 20 to see if the name equals "s" + loop number. Your wbPaste has the same sheet names, so when it finds s# on wbCopy, it is going to paste into wbPaste with the same sheet name: s1 into s1, s20 into s20, etc. I didn't put in any error handling, so if you have an s21 on your copy workbook, s21 needs to be on your paste workbook, and NumberToCopy changed to 21 (or just set it to a higher number if you plan on adding more).
You could have it just loop through the first 20 sheets, but if someone moves one it will throw it all off. This way sheet placement in the workbook is irrelevant as long as it exists in the paste workbook.
You can also turn screenupdating off if you don't want to have a seizure.
Option Explicit
Sub CopyAll()
'Define variables
Dim wbCopy As Workbook
Dim wsCopy As Worksheet
Dim wbPaste As Workbook
Dim LastRow As Long
Dim i As Integer
Dim wsNameCode As String
Dim NumberToCopy As Integer
'Set variables
i = 1
NumberToCopy = 20
wsNameCode = "Sheet"
'Set these to your workbooks
Set wbCopy = ThisWorkbook
Set wbPaste = Workbooks.Add
'These are just an example, delete when you run in your workbooks
wbPaste.Worksheets.Add
wbPaste.Worksheets.Add
'Loop through all worksheets in copy workbook
For Each wsCopy In wbCopy.Worksheets
'Reset the last row to the worksheet, reset the sheet number search to 1
LastRow = wsCopy.Cells(65536, 1).End(xlUp).Row
i = 1
'Test worksheet name to match template code (s + number)
Do Until i > NumberToCopy
If wsCopy.Name = (wsNameCode & i) Then
wsCopy.Range("A2:T" & LastRow).Copy
wbPaste.Sheets(wsNameCode & i).Paste
End If
i = i + 1
Loop
Next wsCopy
End Sub
Thank you for all of your help, everyone. I went back yesterday afternoon from scratch and ended up with the following code which, at least to my eyes, has solved what I was trying to do. The next step will be to try to make this less tedious as I have a gajillion workbooks to update. If I can find a less obnoxious way to open/update/save/close new workbooks, I will be very happy. As it stands now, however, I have to open both the example workbook and the target workbook, save both, and close...but it works.
'This VBA macro copies a range of cells from specified worksheets within one workbook to a range of cells
'on another workbook; the names of the sheets in both workbooks should be identical although can be edited to fit
Sub CopyToNewTemplate()
Dim x As Workbook
Dim y As Workbook
Dim ws As Worksheet
Dim tbc As Range
Dim targ As Range
Dim InxW As Long
Dim WshtNames As Variant
Dim WshtNameCrnt As Variant
'Specify the Workbook to copy from (x) and the workbook to copy to (y)
Set x = Workbooks("Ch00 Avoid.xlsx")
Set y = Workbooks("Ch00 Avoid1.xlsx")
'Can change the worksheet names according to what is in your workbook; both worksheets must be identical
WshtNames = Array("S1", "S2", "S3", "S4", "S5", "S6", "S7", "s8", "s9", "S10", "S11", "S12", "S13", "S14", "S15", _
"S16", "S17", "S18", "S19", "S20", "Ext1", "Ext2", "Ext3", "EFS BigAverage")
'will iterate through each worksheet in the array, copying the tbc range and pasting to the targ range
For Each WshtNameCrnt In WshtNames
With Worksheets(WshtNameCrnt)
'tbc is tobecopied, specify the range of cells to copy; targ is the target workbook range
Set tbc = x.Worksheets(WshtNameCrnt).Range("A1:T500")
Set targ = y.Worksheets(WshtNameCrnt).Range("A1:T500")
Dim LastRow As Long
Dim NextRow As Long
tbc.Copy targ
Application.CutCopyMode = False
End With
Next WshtNameCrnt
End Sub
I need help creating a piece of code that will.
Identify two separate workbooks: workbook1 (the source file) & workbook2 (active.workbook).
take the column title in workbook1, find that column title in workbook 2 and copy the content of the column from workbook1 into workbook 2.
move to the next column in workbook1 until its title is blank.
This code works for me. Note the comments.
Sub copyA2B()
Dim wb As Workbook
Dim wbSrc As String
Dim cel As Range
'assuming you don't know the source workbook name, looping through the workbooks, otherwise no loop needed
For Each wb In Workbooks
If wb.Name <> ActiveWorkbook.Name Then
wbSrc = wb.Name
Exit For
End If
Next
With Workbooks(wbSrc).ActiveSheet
'assuming the column order is different between the two files, looping through the titles, otherwise no loop needed
For Each cel In .Rows(1).Cells 'assuming the titles are in the first row in both workbooks
If cel <> "" And cel(2) <> "" Then
.Range(cel(2), cel(1).End(xlDown)).Copy Rows(1).Find(cel.Value)(2)
End If
Next
End With
End Sub
I am trying to combine numerous sheets into one new sheet. I would really appreciate any comments.
The issue is with the line:
wsSrc.Range("A1", wsSrc.Range("D", lastRow)).Copy Destination:=rngDest
Which causes the error when I try to run it. I have previously been using the code to combine all the sheets into the sheet Summary which is where the button for the macro is created which worked fine.
Sub mcrCombine()
ActiveWorkbook.Sheets.Add.Name = "Combined" 'Create new sheet
'Definitions
Dim wsSrc As Worksheet
Dim wsDest As Worksheet
Dim rngDest As Range
Dim lastRow As Long
Dim destRow As Long
Set wsDest = Worksheets("Combined") 'Destination sheet in same Workbook
Set rngDest = wsDest.Range("B1") 'Destination cell in Combined
Application.DisplayAlerts = False 'suppress prompt worksheet delete
'loop through all sheets
For Each wsSrc In ThisWorkbook.Sheets
If wsSrc.Name <> "Summary" And wsSrc.Name <> "Combined" Then 'all sheets except summary
lastRow = wsSrc.Cells.SpecialCells(xlCellTypeLastCell).Row 'define last row
wsSrc.Range("A1", wsSrc.Range("D", lastRow)).Copy Destination:=rngDest 'copy and paste data in range
Set rngDest = rngDest.Offset(lastRow - 1) 'update destination range
wsSrc.Delete 'delete source file
End If
Next
Application.DisplayAlerts = True 'prompts back on
End Sub
OK, I am not sure that this will get your code to achieve all what it is supposed to do, but since you corrected to issue pointed out by #Jeeped and specified your issue within this line:
wsSrc.Range("A1", wsSrc.Range("D", lastRow)).Copy Destination:=rngDest
The error in this line is because of the comma instead of the ampersand. You should change it into:
wsSrc.Range("A1", "D" & lastRow).Copy Destination:=rngDest
Hope this helps.
I have previously been using the code to combine all the sheets into the sheet Summary which is where the button for the macro is created which worked fine.
That's the clue as to what is occurring. As you cycle through each of the worksheets in the workbook you take care not to process the Summary worksheet; probably because a) it already holds aggregated information from the other worksheets and b) you do not want it deleted with the other worksheets that are processed.
If you have changed the central location to a Combined worksheet you are going to have to include that in the worksheet(s) to skip over. Failure to skip over the Combined worksheet will a) copy its content on top of itself and b) delete the Combined worksheet.
If wsSrc.Name <> "Summary" And wsSrc.Name <> "Combined" Then
If you delete the Combined worksheet, then there is Nothing in the way of a destination.
I have written data in a cell that is updated by a macro - it appends a reference depending on what somebody has called a new sheet.
In Cell A1 I end up with macro code that is updated with the new sheet name. Currently users have to copy this text and open another macro and paste the code in, however they keep doing it wrong and breaking it.
What I would like to do is write a macro to copy the contents of Cell A1 and paste them into the original macro.
If it possible to do this?
Based on a suggestion at the MrExcel.com forum:
Sub aaa()
For i = 1 To Application.VBE.CodePanes.Count
Application.VBE.CodePanes(i).CodeModule.ReplaceLine 1, "alert('Yo') ' New code"
Next i
I know this is not an answer to your question but I'm just offering some information. I would suggest that you don't have users create a macro in each sheet. You can access anything on any sheet from a module. I am not sure what you whole process is but you could think of it more along the lines of looking for the sheets you want to change.
Public sub ProcessSheets()
Dim ws As Excel.Worksheet
Dim iIndex As Integer
'Loop through all the worksheets in the workbook.
For iIndex = 1 To ActiveWorkbook.Worksheets.count
'Activate the current sheet, if you need to.
Set ws = Worksheets(iIndex)
ws.Activate
'Check the name of the worksheet.
If Left(ws.Name, 2) = "HD" or Left(ws.Name, 2) = "ER" Then
'Call the function that changes the worksheet here.
'Maybe feed it the worksheet name.
UpdateWorksheet ws.Name
End if
Next iIndex
End Sub
In this latest project the desire is to have a button & macro that will do the following:
When clicked the macro will copy all the data from the existing workbook & save it to another location. To create the copy of the workbook I will be using the following code below:
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="C:\Data.xlsm"
Application.DisplayAlerts = True
This code was sourced from - http://goo.gl/t7qOyB
Once the copy has been archived, the data in the existing workbook must then be removed leaving all the formatting behind. How can removing the data but keeping the formatting be achieved?
Use the .ClearContents() property of Cells Collection
Sub ClearAll()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Cells.ClearContents
Next
End Sub
This code iterates through all sheets in the current workbook and deletes the values from cells keeping the formatting.
Update!
If you wanted to clear only specific range on each sheet then
Sub ClearAll()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Range("A1:B20").ClearContents
Next
End Sub
This will clear only range A1:B20 on each sheet.