I am attempting to Copy values in a Row, one by one from each cell, then use those values as worksheet names, one by one. One of the issues I had was skipping the first batch of sheets, so I attempted to hide the ones I don't want renamed. All other sheets should be renamed (34 of them).
I can get it all the way "ws.PasteSpecial xlPasteValues" using F8 before I get an error message that says "Run-time error '1004'L Method 'PasteSpecial' of object'_Worksheet' failed.
I have also tried using "Activesheet.PasteSpecial xlPasteValues" but it gave the same error.
Any suggestions at all are very much appreciated, this is driving me nuts. :) My back up plan is simply using the macro record and doing every rename manually, but it's not a very elegant or simple code that way, so I'd prefer not to do that.
Here is the Code:
Dim ws As Worksheet
Dim TitleID As String
Dim TID As String
Sheets("SheetName1").Activate
Set ws = ActiveSheet
Dim rng As Range, cell As Range
Set rng = ws.Range("C5", "AJ5")
For Each cell In rng
cell.Copy
Sheets("SheetName1").Visible = False
ws.Next.Select
ws.PasteSpecial xlPasteValues
Next cell
If I understand your question, properly, the below code should work.
Dim ws As Worksheet
Set ws = Sheets("SheetName1")
Dim rng As Range, cell As Range
Set rng = ws.Range("C5","AJ5")
Dim i as Integer
i = 5 'this is an arbitrary number, change to whatever number of worksheets
'you wish to exclude that are at the beginning (left most side) of your workbook
'also assumes "SheetName1" is before this number.
For Each cell In rng
Sheets(i).Name = cell.Value
i = i + 1
Next cell
Related
I am writing a VBA macro where I have an InputBox come up, the user will select a range which will be a full column, and then the macro will paste that range in a particular place on another worksheet. I have been trying to make this code work, but I keep getting different errors depending on what I try to fix, so I was wondering if someone could help me out. I have pasted the relevant parts of the code:
Sub Create_CONV_Files()
Dim NewCode As Range
Set NewCode = Application.InputBox(Prompt:="Select the column with the code numbers", Title:="New Event Selector", Type:=8)
Dim RawData As Worksheet
Set RawData = ActiveSheet
Dim OffSht As Worksheet
Set OffSht = Sheets.Add(After:=Sheets(Sheets.Count))
OffSht.Name = "offset.sac"
Worksheets(RawData).Range(NewCode).Copy _
Destination:=OffSht.Range("A:A")
End Sub
I have tried making the input a string instead, but I am also getting errors there and am not sure how to fix that. I was hoping to use roughly the method I have outlined as my full code has multiple destination sheets and ranges.
Thank you very much for any help you can offer!
once you have set a Range object it brings with it its worksheet property so there's no need to qualify its worksheet
Sub Create_CONV_Files()
Dim NewCode As Range
Set NewCode = Application.InputBox(prompt:="Select the column with the code numbers", title:="New Event Selector", Type:=8)
Dim OffSht As Worksheet
Set OffSht = Sheets.Add(After:=Sheets(Sheets.count))
OffSht.Name = "offset.sac"
NewCode.Copy _
Destination:=OffSht.Range("A1")
End Sub
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 have lots of data (numbers) with heading in several worksheets that I am trying to zero. This is done on each column as follows: Taking the value of the first row in the column and subtracting this value from all rows in the column.
I have put together this code (may not be the best way, but Im new to VBA so :))
Dim ws As Worksheet
Dim Header As Range, Coldata As Range
Dim firstrow As Long
Dim cell As Range, cell2 As Range
Set ws = ActiveSheet
Set Header = ws.Range("B5:CJ5")
For Each cell In Header
If cell Is Nothing Then Exit For
firstrow = cell.Offset(2).Value
***Set Coldata = ws.Range(cell.offset(3),cell.Offset(3)).End(xlDown)***
cell.Value = 0
For Each cell2 In Coldata
cell2.Value = cell2.Value - firstrow
Next
Next
MsgBox "Done zeroing"
This sub is under the Module of the workbook I am working on. Whenever I run this sub from inside the VBA window it gives me the error I stated in the description on the Line of the code with **** around it.
When I try to run it from a workhsheet it says Cannot run the macro. The macro may not be avaiable in this worksheet or all macros may be disabled. The thing is I run another macro in the same module it works, so macros being disabled is out of the question.
What am I missing?
Thanks in advance!
Edit, I fixed it.. But running it takes SO much time? Excel freezes when I run it though?
You are over-specifying. Replace:
Set Coldata = ws.Range(cell.Offset(3)).End(xlDown)
with:
Set Coldata = cell.Offset(3).End(xlDown)
cell is fully qualified already.
I have a list of values in a excel name range .I want to write a VB code so as to create worksheets using those list of values.These list of values keep on changing.
Here is the code:
Sub AddSheets()
Dim cell As Excel.Range
Dim wsWithSheetNames As Excel.Worksheet
Dim wbToAddSheetsTo As Excel.Workbook
Dim i As Integer
i = 0
Set wsWithSheetNames = ActiveSheet
Set wbToAddSheetsTo = ActiveWorkbook
For Each cell In wsWithSheetNames.Range("sheet_name").End(xlDown)
With wbToAddSheetsTo
.Sheets.Add after:=.Sheets(.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = cell.Value
If Err.Number = 1004 Then
Debug.Print cell.Value & " already used as a sheet name"
End If
On Error GoTo 0
End With
Next cell
Here sheet_name(cells in a single column) is the namerange where the name of the sheets to be created is dumped.
The no of sheets may change.
My above code does not work correctly , it just creates the a sheet with the sheet name of last value in this range.Where am i going wrong? I am new to VB.what may be a better way to do this?
This line:
For Each cell In wsWithSheetNames.Range("sheet_name").End(xlDown)
Get rid of the .End(xlDown), this is only grabbing the last value, as you said.
In naming the range, just using the name already has the entire range defined.
You are almost there. Notice the line below in your script, and just get rid of .End(xldown) at the end.
---For Each cell In wsWithSheetNames.Range("sheet_name").End(xlDown)-----
change to
---For Each cell In wsWithSheetNames.Range("sheet_name")-----
Then it will add the individual sheetname one after another.
The following VBA code (Excel 2007) is failing with Error 1004, "Autofill Method of Range Class Failed.". Can anyone tell me how to fix it?
Dim src As Range, out As Range, wks As Worksheet
Set wks = Me
Set out = wks.Range("B:U")
Set src = wks.Range("A6")
src.AutoFill Destination:=out
(note: I have Googled, etc. for this. It comes up fairly often, but all of the responses that I saw had to do with malformed range addresses, which AFAIK is not my problem.
At someone's suggestion I tried replacing the autofill line with the following:
src.Copy out
This had the effect of throwing my Excel session into an apparent infinite loop consuming 100% CPU and then just hanging forever.
OK, apparently the source has to be part of the destination range for autofill. So my code now looks like this:
Dim src As Range, out As Range, wks As Worksheet
Set wks = Me
Set out = wks.Range("B1")
Set src = wks.Range("A6")
src.Copy out
Set out = wks.Range("B:U")
Set src = wks.Range("B1")
src.AutoFill Destination:=out, Type:=xlFillCopy
Same error on the last line.
From MSDN:
The destination must include the
source range.
B:U does not contain A6 and thus there is an error. I believe that you probably want out to be set to A6:U6.
Specifiying just the column name means that you want to fill every row in that column which is unlikely to be the desired behvaiour
Update
Further to the OP's comment below and update to the original answer, this might do the trick:
Dim src As Range, out As Range, wks As Worksheet
Set wks = Me
Set out = wks.Range("B1")
Set src = wks.Range("A6")
src.Copy out
Set out = wks.Range("B1:U1")
Set src = wks.Range("B1")
src.AutoFill Destination:=out, Type:=xlFillCopy
Set out = wks.Range("B:U")
Set src = wks.Range("B1:U1")
src.AutoFill Destination:=out, Type:=xlFillCopy
AutoFill is constrained to a single direction (i.e. horizontal or vertical) at once. To fill a two-dimensional area from a single cell you first have to auto-fill a line along one edge of that area and then stretch that line across the area
For the specific case of copying the formatting and clearing the contents (by virtue of the source cell being empty), this is better:
Dim src As Range, out As Range, wks As Worksheet
Set wks = Sheet1
Set out = wks.Range("B:U")
Set src = wks.Range("A6")
src.Copy out
To make AutoFill work, you need to make the range of AutoFill more than the source range. If the AutoFill range is same as of Source range then there is nothing to AutoFill in that range and hence you would get an error
1004: AutoFill method of Range class failed.
So make AutoFill range more than the source range and error will gone.
If you want to autofill you just do something like...
Private Sub Autofill()
'Select the cell which has the value you want to autofill
Range("Q2").Select
'Do an autofill down to the amount of values returned by the update
Selection.AutoFill Destination:=Range("Q2:Q10")
End Sub
This would autofill down to the specified range.
Does ths help?
Not sure if this helps anyone, but I needed something similar. Selecting the cells as destination works;
dim rowcount as integer
Sheets("IssueTemplate").Select ' Whatever your sheet is
rowcount = 0
rowcount = Application.CountA(Range("A:A"))'get end range
Cells(4, 3).Select 'select the start cell
'autofill to rowcount
Selection.AutoFill Destination:=Range("C4:C" & rowcount), Type:=xlFillDefault
in my example I had to auto-generate a list of folder names from OA100 to OA###?, and this worked fine.