I am trying to run a single macro which performs functions on multiple worksheets. Let's say I have assigned the macro button on worksheet 4. I have listed the functions I want it to perform step by step:
1) Select certain cells in worksheet 4 and copy to adjacent cells in worksheet 4.
2) delete range of cells in worksheet 3.
3) CUT range of cells in worksheet 2 then paste this range of cells into worksheet 3.
4) Take range of cells from a separate workbook and copy into worksheet 2. (I know this is an entirely different problem as the workbook is automatically published and I will have to find a way to link the two.)
5) Update pivot tables located within Worksheet 4 and Worksheet 3.
I would love help on the first 3 functions of this. I've pasted my current code below.
Sub START()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim sh4 As Worksheet
Set sh1 = ActiveWorkbook.Sheets("Brand")
Set sh2 = ActiveWorkbook.Sheets("CurrentWeek")
Set sh3 = ActiveWorkbook.Sheets("PriorWeek")
Set sh4 = ActiveWorkbook.Sheets("Pivot")
sh4.Range("B29:B30").Select
Selection.Copy
sh4.Range("C29").Select
ActiveSheet.Paste
sh3.Range("A4:AC1000").Select
Selection.Delete
sh2.Range("A4:AC1000").Select
Selection.Copy
sh3.Range("A4").Select
ActiveSheet.Paste
End Sub
It works... but it only works when I'm in the right worksheet to perform a specific function.
By removing the select, the selection and the activesheet, you will be able to make this sheet-independent
Sub START()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim sh4 As Worksheet
Set sh1 = ActiveWorkbook.Sheets("Brand")
Set sh2 = ActiveWorkbook.Sheets("CurrentWeek")
Set sh3 = ActiveWorkbook.Sheets("PriorWeek")
Set sh4 = ActiveWorkbook.Sheets("Pivot")
sh4.Range("B29:B30").Copy sh4.Range("C29")
sh3.Range("A4:AC1000").Delete
sh2.Range("A4:AC1000").Copy sh3.Range("A4")
End Sub
You are off to a great start. Just little more refinement and you'll have it.
Basically, there's no need to .Select your ranges (sheets, workbooks, etc), at least in this case. You can work directly with them and by using the Copy supply the destination where they will be copied.
See code below:
Sub START()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim sh4 As Worksheet
Dim wkb As Workbook
Set wkb = Workbooks("wkbName") '-> best to call workbooks by name, as opposed to "ActiveWorkbook", also best to set it to object
With wkb '-> now we can work with this object directly and succinctly
Set sh1 = .Sheets("Brand")
Set sh2 = .Sheets("CurrentWeek")
Set sh3 = .Sheets("PriorWeek")
Set sh4 = .Sheets("Pivot")
sh4.Range("B29:B30").Copy sh4.Range("C29")
'sh3.Range("A4:AC1000").Delete -> you don't need this if you are overwritting it
sh2.Range("A4:AC1000").Copy sh3.Range("A4")
End With
End Sub
sheets("name1").range("B29:B30").copy Destination:=sheets("name2").range("C29")
Will copy from one to another sheet assuming the sheet names are name1 and name2
Sub START()
Sheet("Pivot").Range("B29:B30").Copy Sheet("Pivot").Range("C29")
Sheet("CurrentWeek").Range("A4:AC1000").Copy Sheet("PriorWeek").Range("A4")
End Sub
Related
I am new to vba. I am trying to copy header row from one sheet to newly created another sheet. I am getting an out of range error when try to select new worksheet. Below is the code i am using.
With Sheets("Details Master")
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rngsource As Range
Dim rngDest As Range
Set ws1 = Sheets("Details Master")
'Sheets("Details Master").Select
Set rngsource = ws1.Range("B2:L2")
rngsource.Copy
End With
With Sheets("Sh_name") **'Error on this line**
Set ws2 = Sheets("Sh_name") 'Sh_name is newly created sheet name
Set rngDest = ws2.Range("B2:L2")
rngDest.PasteSpecial
End With
Any idea what might be the issue.
You failed to add the new worksheet, as #Storax and # ashleedawg commented.
When using this basic code, please change the new worksheet name from "Temp" to what you want your worksheet name to be. Also make sure the name in the Destination line is the same name.
With ThisWorkbook
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Temp"
Sheets("Details Master").Range("B2:L2").Copy Destination:=Sheets("Temp").Range("B2")
End With
I feel like this is too simple to be stuck on, but I have a workbook with about 100 sheets, and I need to copy a range from one sheet (Sheet2 Range a1:H200) to Sheet5 AF1:AM200 and every sheet after (Sheet5 through Sheet100 or more). I have tried creating a loop and copying the original range and pasting to each sheet, but it hasn't worked. I feel like this is the closest I've gotten
Sub CopyPasteLoop()
Dim wsVar As Worksheet
For Each wsVar In ThisWorkbook.Sheets
With wsVar
ThisWorkbook.Worksheets("Sheet2").Range("A1:H200").Value = ThisWorkbook.Worksheets("Sheet5").Range("AF1").Value
End With
Next wsVar
End Sub
I feel like it should be simpler, but I can't make it work. Thanks!
Almost there. Try this:
Sub CopyPasteLoop()
Dim wsVar As Worksheet
Dim i as Integer
For i = 5 to ThisWorkbook.Worksheets.Count
ThisWorkbook.Worksheets(i).Range("AF1:AM200").Value = ThisWorkbook.Worksheets("Sheet2").Range("A1:H200").Value
Next i
End Sub
Or for better performance, use this:
Dim vRange as Variant
vRange = ThisWorkbook.Worksheets(2).range("A1:H200")
Dim i as Integer
For i = 5 to ThisWorkbook.Worksheets.Count
ThisWorkbook.Worksheets(i).Range("AF1:AM200").Value = vRange
Next i
Hopefully #Scott Holtzman's answer will work for you (providing your sheets are indexed in the same order as they're named). This approach will also work.
Dim wb As Workbook, ws As Worksheet
Dim rng As Range
Set wb = ThisWorkbook
Set rng = wb.Sheets("Sheet2").Range("A1:H200")
For Each ws In wb.Sheets
If CInt(Right(ws.Name, Len(ws.Name) - Len("Sheet"))) >= 5 Then
ws.Range("AF1:AM200").Value = rng.Value
End If
Next ws
I need to create a macro in my CountResults.xlsm (Master Workbook) that solves the following problem. I have a column of data in another worksheet with either YES or NO. I need to come up with a macro that counts the amount of "YES" in the column. The column is located in Sheet2 of the workbook Test01.xlsx. Then take that count and put it in one cell in my CountResults.xlsm file. Like so:
I have a code that displays a count for a column in the same sheet. But this code does not count when there are 'breaks' in the column (empty spaces) like I have in my picture. This is that code:
Private Sub CommandButton1_Click()
MsgBox Range("A1").End(xlDown).Row
Range("A1").End(xlDown).Offset(1, 0).Select
End Sub
I have another code that helps with accessing another workbook and defining values for each workbook and worksheet:
Dim wbSource As Workbook
Dim wbTarget As Workbook
Dim shSource As Worksheet
Dim shTarget As Worksheet
Set wbSource = Workbooks.Open(Filename:="C:\Users\khanr1\Desktop\Test_Excel\Test03.xlsm", ReadOnly:=True)
Set wbTarget = ThisWorkbook
Set shSource = wbSource.Worksheets("Sheet2")
Set shTarget = wbTarget.Worksheets("Sheet1")
Use COUNTIF. It will give you the total even if the range is in another workbook. i.e. =COUNTIF([Book2.xlsx]Sheet2!$D$2:$D$9, "Yes"). Problem with having COUNTIF within your sheet as a formula is that you will need to open the other workbook if you want the count to be update. Below VBA code will perform an update for you. Assign the sub to a button in your CountResults.xlsm workbook
EDIT: Added row count as per OP's requirement
Sub UpdateResults()
Dim oWBWithColumn As Workbook: Set oWBWithColumn = Application.Workbooks.Open("<your Test01.xlsx address here>")
Dim oWS As Worksheet: Set oWS = oWBWithColumn.Worksheets("Sheet2")
Dim intLastRow as Integer: intLastRow = oWS.Cells(Rows.Count, "B").End(xlUp).Row
ThisWorkbook.Worksheets("<name of the sheet in your CountResults.xlsm workbook>").Range("<cell address>").Value = Application.WorksheetFunction.CountIf(oWS.Range("B2:B" & intLastRow), "yes")
oWBWithColumn.Close False
Set oWS = Nothing
Set oWBWithColumn = Nothing
End Sub
I have the following code at the start of a routine:
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Set ws1 = Workbooks.Open(ThisWorkbook.Sheets(1).[b4]).Sheets(1)
Set ws2 = Workbooks.Open(ThisWorkbook.Sheets(1).[b6]).Sheets(1)
Set ws3 = Workbooks.Open(ThisWorkbook.Sheets(1).[b8]).Sheets(1)
ws1.Move after:=ThisWorkbook.Sheets("MAIN")
ws2.Move after:=ThisWorkbook.Sheets("MAIN")
ws3.Move after:=ThisWorkbook.Sheets("MAIN")
'// remove redundant data
With ws1
With .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
...
Everything seems fine until the second With block, when I get an automation error:
Run-time error '-2147221080 (800401a8)':
Automation Error
Each of the files are CSV files with a single sheet, If I look in the locals window as they are being set they show as Worksheet/Sheet1 as I expect. Once I move the sheets to ThisWorkbook however, I notice that the type changes to Worksheet/Worksheet and I am no longer able to refer to ws1, ws2 or ws3 using the respective variables. The variables show as worksheet objects in the locals window and appear to be set to an object, but when I expand the variable's node it just states <No Variables>.
I haven't seen this behavior before in VBA so any explanations or suggestions would be greatly appreciated.
Thanks in advance.
The problem is that when you move a sheet from a 1 sheet workbook, it closes the workbook. would need to refer to the sheet in the current workbook not the one from the opened workbook. Code similar to below would work.
Sub tt()
Dim ws1 As Worksheet
Set ws1 = Workbooks.Open(ThisWorkbook.Sheets(1).[b1]).Sheets(1)
ws1_Name = ws1.Name
ws1.Move after:=ThisWorkbook.Sheets(1)
'// remove redundant data
With ThisWorkbook.Sheets(ws1_Name)
With .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With
End With
End Sub
You could also reset ws1 to the correct sheet
Set ws1 = ThisWorkBook.Sheets(ws1_Name)
I am looking for a simple solution to this problem.
the code below is my attempt, is the filtering portion for the source workbook correct in its approach?
Also, I want to insure the sourceworkbook is left was it was upon filtering and copying
Many thanks for any ideas!
Sub CopyFilteredValuesToActiveWorkbook()
Dim sourceValues As Range, targetValues As Range
Set sourceValues = Workbooks("\\Linkstation\rrm\X_DO_NOT_TOUCH_CC\MasterLogFile\Masterlogfile.xlsx").Worksheets("LogData").Columns("A:Z")
ActiveSheet.Range("$A$1:$H$3").AutoFilter Field:=3, Criteria1:="Opera"
Set targetValues = Workbooks("\\Linkstation\rrm\Campaign Creator\RAW DATA GENERATOR OPERA.xlsm").Worksheets("MLF").Columns("A:Z")
sourceValues.Copy Destination:=targetValues
End Sub
Try something like this - defining the workbooks / sheets as variables makes it a lot easier to manage everything. I assumed you'd want the macro to open the other workbook for you - if not, the code can be altered easily.
Sub CopyFilteredValuesToActiveWorkbook()
Dim wbSource As Workbook, wbDest As Workbook
Dim wsSource As Worksheet, wsDest As Worksheet
Dim rngSource As Range, rngDest As Range
Set wbSource = Workbooks.Open("\\Linkstation\rrm\X_DO_NOT_TOUCH_CC\MasterLogFile\Masterlogfile.xlsx", , True) 'Readonly = True
Set wsSource = wbSource.Worksheets("LogData")
wsSource.Range("$A$1:$H$3").AutoFilter Field:=3, Criteria1:="Opera"
Set rngSource = wsSource.Range("A:Z")
Set wbDest = ThisWorkbook
Set wsDest = wbDest.Worksheets("MLF")
Set rngDest = wsDest.Range("A:Z")
rngDest.Value = rngSource.Value 'Copies values over only, if you need formatting etc we'll need to use something else
wbSource.Close (False) 'Close without saving changes
End Sub