Repeating macro code - vba

I recorded this macro:
Sheets("Sheet1").Select
Range("D4:E4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ALB3").Select
Range("C1").Select
ActiveSheet.Paste
I want to make a loop to repeat the process.
From range D4:E4 to D200:E200 when do select
To paste that on respective sheet name from ALB3 to ALB196.
My data in sheet 1.
Column a is sheets name, column d4 and e4, is the data that I want to paste on every sheet already created.

If you're trying to copy a range from one sheet to another, you don't need a loop and you don't need to select. You can use copy syntax that doesn't use your clipboard.
Try this:
Sub CopyRangeToAnotherSheet()
Dim source As Worksheet
Dim target As Worksheet
Set source = ActiveWorkbook.Sheets("Sheet1")
Set target = ActiveWorkbook.Sheets("Sheet2")
source.Range("D4:E200").Copy target.Range("ALB3")
End Sub
To copy the source range to all sheets in the workbook except the source worksheet, try this:
Sub CopyToAllSheets()
Dim ws As Worksheet
For Each ws In Worksheets
CopyRangeToAnotherSheet (ws.Name)
Next
End Sub
Sub CopyRangeToAnotherSheet(targetName As String)
Dim source As Worksheet
Dim target As Worksheet
Set source = ActiveWorkbook.Sheets("Sheet1")
Set target = ActiveWorkbook.Sheets(targetName)
If target.Name <> source.Name Then
source.Range("D4:E200").Copy target.Range("ALB3")
End If
End Sub

Related

VBA on data source update I want to update a different sheets sort order

I have this working thus far for the datasource sheet. But on another sheet called WatchList I want to update the sort order for 1 of the columns which does a look up when the data source updates. I tried several items and cant get it working.
As far as my range it starts at at the top of the sheet WatchList and goes to column L. And the sort I want to do is on column H.
Private Sub Worksheet_Activate()
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sheet As Worksheet, Pivot As PivotTable
For Each Sheet In ThisWorkbook.Worksheets
For Each Pivot In Sheet.PivotTables
Pivot.RefreshTable
Pivot.Update
Next
Next
Dim wb As Workbook
Set wb = ActiveWorkbook
Dim ws As Worksheet
Set ws = wb.Sheets("WatchList")
Dim rng As Range
Set rng = Sheet2.Range("A2:L69")
ws.Range(rng).Sort Key1:=Range("H2:H69"), Order1:=xlAscending, Header:=xlNo
End Sub
I am getting run-time error '1004';
Method 'Range' of object'_Worksheet' failed
Any help is much appreciated

Changing value of a cell in multiple worksheets from a range in another workbook

So i have a workbook with around 500 worksheets, and i need to change the value of a cell, say A1, in each worksheet, to a value in a range from another workbook.
For example,
the value of A1 in Sheet1 in Workbook1 = A1 in Sheet1 of Workbook2
the value of A1 in Sheet2 in Workbook1 = A2 in Sheet1 of Workbook2
the value of A1 in Sheet3 in Workbook1 = A3 in Sheet1 of Workbook2
etc.
I've been trying to alter and use the following, but getting nowhere, any help would be appreciated.
Thanks
Sub mycode()
For Each Worksheet InThisWorkbook.Sheets
Range(“A1″) = “Exceltip”
Next
End Sub
Try this:
Open your destination workbook and store a reference to the workbook in a variable
Loop through the worksheets in your current workbook using a For loop
Fully qualify your references, using this new variable name and ThisWorkbook to distingish between ranges on different workbooks.
Sub TransferValues()
Dim workbook2 As Workbook
Dim i As Long
Set workbook2 = Workbooks.Open("C://My Documents/.../SomeWorkbook2.xlsx")
For i = 1 To ThisWorkbook.Worksheets.Count
ThisWorkbook.Worksheets(i).Range("A1").Value = workbook2.Worksheets("Sheet1").Range("A1").Offset(i - 1, 0).Value
Next i
workbook2.Close SaveChanges:=False
End Sub
here's a variation on CallumDA code, mainly to optimize memory accesses and, hence, performance (should it ever be an issue):
Sub TransferValues()
Dim myValues As Variant
With Workbooks.Open("C://My Documents//SomeWorkbook2.xlsx") 'open and reference "source " workbook
myValues = Application.Transpose(.Worksheets("Sheet1").Range("A1").Resize(ThisWorkbook.Worksheets.Count).Value) 'store referenced workbook "Sheet1" worksheet values in column A from row 1 down to "workbook1" (i.e. the one where the macro resides in) sheets number
.Close False 'close referenced workbook
End With
Dim sht As Worksheet
For Each sht In ThisWorkbook.Worksheets
sht.Range("A1").Value = myValues(sht.Index)
Next
End Sub

VBA - Calling from another workbook

Trying to delete sheets based on data from another workbook sheet - By comparing and accessing data from another workbook sheet, however its not working. I was able to do it if the sheet was in the same workbook, however i do not want to import the worksheet every time.
Code so far, My problem is calling from another workbook sheet.
sub delete()
Dim wb As Workbook
Dim wks As Worksheet
Dim MyRange As Range
Dim Cell As Range
Set wb = Workbooks("name.xlsx")
Set wks = wb.Worksheets("allnames")
With wks
Set MyRange = wks.Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
End With
On Error Resume Next
Application.DisplayAlerts = False
For Each Cell In MyRange
Sheets(Cell.Value).Delete
Next Cell
Application.DisplayAlerts = True
On Error GoTo 0
End Sub
Thanks in advance
maybe you're after something like this:
Option Explicit
Sub delete()
Dim toDeleteSheetsWb As Workbook
Dim Cell As Range
Set toDeleteSheetsWb = Workbooks("WorkbookWithSheetsToDelete.xlsx") '<-- set the workbook whose sheets will be deleted (change "WorkbookWithSheetsToDelete.xlsx" to its actual name)
With Workbooks("name.xlsx").Worksheets("allnames") '<-- reference the worksheet from which to read worksheets names to be deleted in "WorkbookWithSheetsToDelete.xlsx" workbook
Application.DisplayAlerts = False
For Each Cell In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
toDeleteSheetsWb.Sheets(Cell.Value).delete
Next Cell
Application.DisplayAlerts = True
End With
End Sub

Excel VBA: Counting Data in Column from Another Workbook and Inputting Counter in Master Workbook

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

Excel vba to copy and paste a cells from different worksheets to new worksheet

i need a macro to copy and paste a certain cells(b5:d10) from multiple worksheets and paste it into a new single worksheet. just i want to collide the contents .thanks in advance
sub copyrange()
range("b5:d10).copy
range("e1").select
activesheet.paste
application.cutcopymode=false
endsub
my code doesnot copy all the worksheets data. kindly help me to copy and paste it
Sub copyrange()
Dim rngTarget As Range, wksTemp As Worksheet
Set rngTarget = ThisWorkbook.Worksheets(1).Range("A2:C7")
For Each wksTemp In ActiveWorkbook.Worksheets
rngTarget.Value = wksTemp.Range("B5:D10").Value
Set rngTarget = rngTarget.Offset(6)
Next wksTemp
End Sub