I am trying to copy the range of value from one sheet in excel to another. I have copied this formula from another part of my sheet that works however i cam coming up with the run time error 9.
Sub SaveJambStudEC()
'
' SaveCalcsJambEC Macro
'
Dim page As Integer
page = Cells(4, "T").Value
Range("A70:AN70").Select
Selection.Copy
Range("A71").Select
ActiveCell.Offset(page, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1:O63").Select
Selection.Copy
Sheets("10.3 JambCalcs EC").Select
Range("A1").Select
ActiveCell.Offset((page - 1) * 63, 0).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats
Sheets("9.3 Jamb Design EC").Select
Range("T5").Select
Selection.Copy
Range("N9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("T31").Value = 0
Call JambECsetDesignOptions
Call CopyJambOptiValues
Range("J9").Activate
End Sub
using the below code you will check if there is a sheet with that name. if you dont receive any message box means that there is no sheet with such name
Option Explicit
Sub test()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "10.3 JambCalcs EC" Then
MsgBox "Sheet Appears"
Exit Sub
End If
Next ws
End Sub
Note
'ThisWorkbook' refer to the workbook that the code included. If you want to clearly declare the workbook you could declare a variable 'Dim wb as Workbook' and then set the workbook 'Set wb=Workbooks("workbook name")'
Related
I have two cells (R5 and S5) that are aggregates based on a RAND() function. I want to create a running list of those values, which change every time the sheet recalculates. The list should have about 100K iterations of this. I wrote a "dumb" bit of VBA that copy/pastes the values into a list.
This does sort of work, but is too slow to scale to 100k iterations and I get a gap every 50 records for some reason.
There must be a better / faster way to do this with a loop or something like that? TIA.
Sub Macro2()
'
' Macro2 Macro
'
'
Range("R5:S5").Select
Selection.Copy
Range("U5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("U6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("U7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
A Worksheet Calculate
Sheet Module e.g. Sheet1
Option Explicit
Private Sub Worksheet_Calculate()
Macro2 Me
End Sub
Standard Module e.g. Module1
Option Explicit
Sub Macro2(ByVal ws As Worksheet)
Application.EnableEvents = False
Dim lCell As Range
Set lCell = ws.Cells(ws.Rows.Count, "U").End(xlUp).Offset(1)
lCell.Resize(, 2).Value = ws.Range("R5:S5").Value
Application.EnableEvents = True
End Sub
I have the code below and what I'm trying to accomplish is:
Remove all the filtered results and create a new table without the filtered results. The problem with this code is that every time when including a new sheet I have to add this line of code for it. Is there any way to workaround this? I've tried using For Each...Next statement but didn't have any success with it.
Edit: the Sheet1, Sheet2 etc. are created earlier in the macro only for this purpose.
Sub macro
Worksheets("cat").ListObjects(1).Range.SpecialCells(xlCellTypeVisible).Copy
Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Worksheets("Sheet1").Paste
Worksheets("cat").Delete
Worksheets("Sheet1").Name = "cat"
Worksheets("dog").ListObjects(1).Range.SpecialCells(xlCellTypeVisible).Copy
Worksheets("Sheet2").Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Worksheets("Sheet2").Paste
Worksheets("dog").Delete
Worksheets("Sheet2").Name = "dog"
Worksheets("meow").ListObjects(1).Range.SpecialCells(xlCellTypeVisible).Copy
Worksheets("Sheet3").Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Worksheets("Sheet3").Paste
Worksheets("meow").Delete
Worksheets("Sheet3").Name = "meow"
Worksheets("bark").ListObjects(1).Range.SpecialCells(xlCellTypeVisible).Copy
Worksheets("Sheet4").Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Worksheets("Sheet4").Paste
Worksheets("bark").Delete
Worksheets("Sheet4").Name = "bark"
End Sub
Please, try the next code:
Sub macroIterateSh()
Dim sh As Worksheet, shNew As Worksheet, shName As String
For Each sh In ActiveWorkbook.Sheets
If sh.ListObjects.Count > 0 Then 'for the case of some other sheets not containing a list object...
Set shNew = Worksheets.Add(Before:=sh)
sh.ListObjects(1).Range.SpecialCells(xlCellTypeVisible).Copy
shNew.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
shNew.Paste
shName = sh.Name: sh.Delete
shNew.Name = shName
End If
Next
End Sub
I'm extremely new to VBAs and cannot figure out how to add a value to the next row if there's already data previous row. I'm sure I'm overthinking it, but I cannot seem to figure it out. Any help would be appreciated.
Below is the macro I'm using. Not sure if I need to offset the data or maybe add an if then statement of some sort.
Sub Archive_2()
Range("A2").Select
Selection.Copy
Sheets("Campaign Rate").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Use below sub-
Sub CopyPaste()
Dim sh As Worksheet
Dim lRng As Range
Set sh = Worksheets("Campaign Rate")
Set lRng = sh.Cells(sh.Rows.Count, 1).End(xlUp)
Range("A2").Copy
lRng.Offset(1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Set sh = Nothing
Set lRng = Nothing
End Sub
When I run my code I get a "400" error message. but it is only the last part of my code that doesn't work("creating template"). Im trying to copy cells A1:BA1000 from the sheet "Data" to a new sheet which is named based on the value of cell EU12 in the data sheet.
'copy the last values from december
Range("HI5:IA1000").Select
Selection.Copy
Range("IC5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'copy the date to new workbook.
Range("EU8").Select
Selection.Copy
Range("EU12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'copy sheet to new workbook
sheettocopy = Range("EU10").Value
Worksheets(sheettocopy).Copy
'adding sheet and renaming
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = Sheets("Data").Range("EU12").Value
'creating template
Sheets("Data").Select
Range("A1:BA1000").Select
Selection.Copy
ActiveWorkbook.Sheets(Worksheets("Data").Range("EU12").Value).Activate
Range("A1").Select
ActiveSheet.Paste
EDIT:
made a new macro just for the creation of a template, the code works(when stored in a module) but when i copy my first sheet in the beginning the module doesnt follow:
Sub addinfo()
'creating template
Set wk = ThisWorkbook
Dim template As String
template = Sheets("Data").Range("EU12").Value
wk.Sheets("Data").Range("A1:BA1000").Copy wk.Sheets(template).Range("A1")
End Sub
How can I create a macro that would do the following:
Copy the range A2:AT10000 from one workbook to the first sheet of a new workbook.
Go back to the initial workbook and select range A6:HF10000 in the sheet with codename: Sheet11
Paste the selection to a newly added worksheet (sheet 2) of the workbook created in step 1
I get a run time error 424 and when debugging, the highlighted line is
Sheet11.Range("A6:HF10000").Select
Sub Copy2RangesNewWorkbook()
'
' Copy2RangesNewWorkbook Macro
'
Dim pvt_wbk_New As Excel.Workbook
Dim pvt_xls_Current As Excel.Worksheet
With pvt_xls_Current
ActiveSheet.Range("A2:AT10000").Select
Selection.Copy
End With
Set pvt_wbk_New = Application.Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
With pvt_xls_Current
Sheet11.Range("A6:HF10000").Select
Selection.Copy
End With
With pvt_wbk_New
Sheets.Add After:=Sheets(Sheets.Count)
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
End Sub
Try:
Sub Copy2RangesNewWorkbook()
Dim pvt_wb_New As Excel.Workbook
Dim pvt_ws_NewTarget1 As Worksheet
Dim pvt_ws_NewTarget2 As Worksheet
Dim pvt_ws_Current As Worksheet
Dim pvt_wb_Current As Workbook
Set pvt_ws_Current = ActiveSheet
Set pvt_wb_Current = ActiveWorkbook
Set pvt_wb_New = Application.Workbooks.Add
Set pvt_ws_NewTarget1 = pvt_wb_New.Sheets(1)
Set pvt_ws_NewTarget2 = pvt_wb_New.Worksheets.Add
pvt_ws_Current.Range("A2:AT10000").Copy
pvt_ws_NewTarget1.Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
pvt_wb_Current.Sheets("Sheet11").Range("A6:HF10000").Copy
pvt_ws_NewTarget2.Range("A6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub