I have my data on sheet 1 and my button macros on sheet 2. Basically when someone presses a button I want it to take a value in a cell in sheet 1 and populate the equivalent cell in sheet 2.
for example
Button 1 -> take value in sheet 1 cell A1 and put into sheet 2 cell A1
My current macro contains the actual value
Sub SelectCell()
Range("L4").Value = ("200")
Range("L5").Value = ("80")
End Sub
Clone Values
s - Source, d - Destination
The code is to be copied to a standard module e.g. Module1.
It is assumed that you have a button on the destination worksheet, and whatever range you select on it, after pressing the button, the values from the source worksheet will be copied over. Multi-area ranges (e.g. "A1,C3,E12") are also covered.
The Code
Option Explicit
Sub cloneValues()
Const sName As String = "Sheet1"
Const dName As String = "Sheet2"
Dim wb As Workbook: Set wb = ThisWorkbook
If TypeName(Selection) = "Range" Then
If Selection.Worksheet Is wb.Worksheets(dName) Then
Dim drg As Range
For Each drg In Selection.Areas
drg.Value = wb.Worksheets(sName).Range(drg.Address).Value
Next drg
End If
End If
End Sub
First you should set your worksheets that you dont need to write it anymore. I asigned Sheet1 to ws1 and sheet2 to ws2.
Sub copy()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
ws2.Range("L4").Value = ws1.Range("L4").Value
'Loop from A1 to A100 and copy the values to sheet2
For i = 1 To 100
ws2.Cells(i, 1).Value = ws1.Cells(i, 1).Value
Next
End Sub
Related
Stuck at this annoying problem, I want to filter cells from a data in M_Sheet, select the filtered region of cells that have "New Code" in Range("x6") and paste it in a new sheet.
For some reasons the cells are not copying or pasting
Set M_Sheet = Comp_Book.Worksheets("Sheet1") 'Comp_Book is a variable for a book currently open
M_Sheet.range("B6:F1835").AutoFilter Field:=6, Criteria1:="New Code"
M_Sheet.range("B6:F1835").SpecialCells(xlCellTypeVisible).Copy
'A code suggestion needed to paste the copied region in new a worksheet
starting from Column B
What i have tried
Dim N_Sheet = Comp_Book.Worksheets("Sheet2)
N_Sheet.cells(2,2).paste
AutoFilter feat. CurrentRegion and SpecialCells
The Code
Sub AutoFilterRange()
Dim wb As Workbook: Set wb = Workbooks("Comp.xlsm")
Dim src As Worksheet: Set src = wb.Worksheets("Sheet1")
Dim rng As Range: Set rng = src.Range("B6").CurrentRegion
rng.AutoFilter Field:=6, Criteria1:="New Code"
Dim tgt As Worksheet: Set tgt = wb.Worksheets.Add
rng.SpecialCells(xlCellTypeVisible).Copy
tgt.Paste
Application.CutCopyMode = False
' Show all data.
'src.ShowAllData
' Turn off AutoFilter.
'rng.AutoFilter
End Sub
This code assigns the range in Comp_Book.Sheet1 and sets a variable to a new worksheet. It will filter the range for "New Code" in Column G, and then copy visible cells in the range to the new worksheet. Comments are provided in the code.
Sub FilterRangeCopytoNewSheet()
'Define your copy range and destination worksheet variables
Dim cpyrng As Range: Set cpyrng = Comp_Book.Sheets("Sheet1").Range("B6:F1835")
Dim destws As Worksheet: Set destws = Comp_Book.Sheets.Add(After:=Sheets(Sheets.Count))
ThisWorkbook.Sheets("Sheet1").AutoFilterMode = False 'Clear any filter
cpyrng.AutoFilter 6, "New Code" 'Field 6 will filter on Column G
cpyrng.SpecialCells(xlCellTypeVisible).Copy destws.Cells(2, 2) 'Copy visible to new sheet
ThisWorkbook.Sheets("Sheet1").AutoFilterMode = False 'Clear filter
End Sub
I have same many Named Range in my wsI with different label (list with different row number but same column number) (es. listA=Sheet1!$A$2:$E$4, listB=Sheet1!$A$5:$E$6 etc). Now I want to copy my Named Range in a wsO, this code works as I expect:
Sub CopyNamedRange()
Dim wsI As Worksheet, wsO As Worksheet
Set wsI = ThisWorkbook.Sheets("Sheet1")
Set wsO = ThisWorkbook.Sheets("Sheet2")
wsO.Range("A1")= "listA"
wsO.Range("listA").Copy wsO.Range("B1")
End Sub
The result is to copy listA cells from the Sheet1!$A$2:$E$4 to Sheet2!$B$1:$F$3 if in Sheet2!A1 was write "listA".
Now, I want to know if it's possible to create a macro that loop through all my labels of the Named Range in wsI and according to the value in Sheet2!A1, copy all the cells.
Secondly, I will introduce a second loop through the Column "A" on Sheet2 in order to find all the different "listX" (es. listA, listB, listA, listC, listB, etc.) and copy automatically the cells in the Sheet2 (obviously if A1=listA will be occupy 3 rows from 1 to 3 the next cell in column A with a "listX" will be in A4 and so on).
This is how:
Option Explicit
Sub Test()
Dim MyNAmes As Name
For Each MyNAmes In ThisWorkbook.Names
'Your code
Next MyNAmes
End Sub
Here the code for my question, if anyone is interested:
Option Explicit
Sub Protocols()
ActiveSheet.UsedRange.Select
Dim wsI As Worksheet, wsO As Worksheet
Dim cell As Range
Dim nm As Name
Set wsI = ThisWorkbook.Sheets("Sheet1")
Set wsO = ThisWorkbook.Sheets("Sheet2")
On Error Resume Next
For Each cell In Columns("A").Cells
If IsEmpty(cell) = True Then
Else
For Each nm In ThisWorkbook.Names
If cell.Value = nm.Name Then Exit For
Next nm
wsI.Range(nm.Name).Copy wsO.Cells(cell.Row, "B")
End If
Next cell
On Error GoTo 0
End Sub
Now the doubt is: it's possible to limit the nm Name searching only in the Named Range stored in Sheet1 (wsI in the example) instead of the whole workbook? I tried to replace
For Each nm In ThisWorkbook.Names
with
For Each nm In wsI.Names
But it seems not work.
Any ideas? Do you think it was possible?
P.S.: It's just to limit the research to the Named Range and avoid unecessary loop!
For each cell in 'myRange' I want to check for a range of values in Sheet2 and if the values in Sheet2 are found in myRange then for the corresponding row I want to put the value from Column A into Column E
As it stands, I'm only able to look for a single value from Sheet2 ("A1"). When attempting to extend this range I get errors.
Is there a way to make the range in Sheet2 dynamic, please?
Sub Find_values()
Dim myRange As Range
Dim Cell As Range
Dim LR As Long
LR = Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
Set myRange = Sheets(1).Range("B1:B" & LR)
For Each Cell In myRange
If Cell.Value = Sheets(2).Range("A1").Value Then Cell.Offset(0, 3) = Cell.Offset(0, -1).Value
Next Cell
End Sub
As others suggested, you can simply nest two For Each loops.
Sub Find_values()
Dim myRange1 As Range
Dim myRange2 As Range
Dim Cell1 As Range
Dim Cell2 as Range
Set myRange1 = Sheets(1).Range(range("B1"),range("B1").end(xlDown))
Set myRange2 = Sheets(2).Range(range("A1"),range("A1").end(xlDown)) 'This range is also dynamic and will adapt to teh number of entries you ahve in Sheet2
For Each Cell1 In myRange1
For Each Cell2 In myRange2
If Cell1.Value2 = Cell2.Value2 Then
Cell1.Offset(0, 3) = Cell1.Offset(0, -1).Value2
Exit for 'Save you some useless processing time since the entry has already been found
end If
Next Cell2
Next Cell1
End Sub
Note I have re-wrote your Range statment to be more cleaner.
Note I have also changed your .value statement into .value2, which depending on the type of data used in your cell will in some cases work better.
Follow this steps:
Convert the data in Sheet1 to an structured Excel table:
1- Select the range from scale's cell to the concatenate last cell
2- Click on the Ribbon "Home" | "Styles" | "Format as table" |
3- Check "My table has headers" box (mark it)
4- Write down the name of the table (While selecting one cell inside the table, look in the "Table tools" ribbon | "Table name"
5- Repeat the previous steps for the data in Sheet2
6- Add the following code to a VBA module:
Sub LookupValues()
' Define object variables
Dim sourceSheet As Worksheet
Dim sourceTable As ListObject
Dim sourceCell As Range
Dim dataSheet As Worksheet
Dim dataTable As ListObject
' Define other variables
Dim sourceSheetName As String
Dim sourceTableName As String
Dim dataSheetName As String
Dim dataTableName As String
' >>>>Customize this<<<<<
sourceSheetName = "Sheet2"
sourceTableName = "Table2"
dataSheetName = "Sheet1"
dataTableName = "Table1"
' Initialize worksheets
Set sourceSheet = ThisWorkbook.Worksheets(sourceSheetName)
Set dataSheet = ThisWorkbook.Worksheets(dataSheetName)
' Initialize source table
Set sourceTable = sourceSheet.ListObjects(sourceTableName)
Set dataTable = dataSheet.ListObjects(dataTableName)
' Loop through every cell in sourceSheet
For Each sourceCell In sourceTable.DataBodyRange.Columns(1).Cells
' >>>>Customize this<<<<<
' In the following code:
' Offset(0, 4) -> 4 stand for 4 columns after column A
' Index(dataTable.DataBodyRange.Columns(1) -> 1 stands to return the first column of the data table
' Match(sourceCell.Value, dataTable.DataBodyRange.Columns(2) -> 2 stands to look in the second column of the data table
If Not IsError(Application.Match(sourceCell.Value, dataTable.DataBodyRange.Columns(2), 0)) Then
sourceCell.Offset(0, 4).Value = Application.Index(dataTable.DataBodyRange.Columns(1), Application.Match(sourceCell.Value, dataTable.DataBodyRange.Columns(2), 0))
End If
Next sourceCell
End Sub
6- Customize the code to fit your needs
7- Test it and let us know if it works
Hope it helps!
I need help to create an automatic method to copy a row to a specific sheet.
I have a Tab (Sales) with a WEB api query importing data in this sheet every 5 min. I have a row within the Sales sheet with a name range identifying each item. The row has 100 different names and there are 100 sheets created with same names within the workbook.
I want to copy the entire row for each item and copy it to the sheet with the same name of the item.
This is to fire off the copy sub:
'Copy Sales data Every 10 Min
Sub test()
'Application.OnTime Now + TimeValue("00:10:00"), "my_Procedure…"
End Sub
I have seen many methods on how to copy the row automatically, but I need help in copy row and use the item name and paste to other sheet with same name.
Without further information here is an outline of what i described in the comments. Here the list of named ranges starts at cell J3 in NamesSheet. In the image, i have shown it in the same sheet (SourceSheet for simplicity). The list is read into an array and that array is looped to select the appropriate sheet to set the values in.
Rather than copy and paste it sets the target row (the next available row), in the sheet accessed by the array index, equal to the source row (copyRow). A With statement is used to avoid selecting the target sheet (more efficient).
No error handling added for missing sheets at present.
I haven't assumed there will be a list of 100 named ranges in the sheet, otherwise you could have sized the array from the start.
Named ranges in ColA of Sales tab:
List of named ranges in Names sheet (abbreviated)
Option Explicit
Private Sub myProc()
Dim wb As Workbook
Dim wsSource As Worksheet
Dim wsNames As Worksheet
Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Sales")
Set wsNames = wb.Worksheets("Names")
Dim namesArr()
namesArr = wsNames.Range("J3:J" & wsNames.Cells(wsNames.Rows.Count, "J").End(xlUp).Row).Value
If UBound(namesArr, 1) <> wsSource.Range("ITEMName").Rows.Count Then
MsgBox "There are not a matching number of named ranges listed in Names sheet."
Exit Sub
End If
Dim i As Long
Dim currLastRow As Long
'Any optimization code could actually go in outer calling sub but consider
'some such as the following
Application.ScreenUpdating = False
Dim copyRow As Range
For i = LBound(namesArr, 1) To UBound(namesArr, 1)
With wb.Worksheets(namesArr(i, 1))
Set copyRow = wsSource.Range(namesArr(i, 1)).EntireRow
If IsEmpty(.Range("A1")) Then 'First row in sheet is available
.Rows(1).Value = copyRow.Value2
Else
currLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(currLastRow + 1).Value = copyRow.Value2
End If
End With
Next i
Application.ScreenUpdating = True
End Sub
Version 2:
Looping Named Ranges in Sales sheet (assumes only 101 Named Ranges in the sheet, tested with workbook scope, and that you will ignore 1 of these which is called ITEMName, no list required in a different sheet. Approach adapted from #user1274820.
Option Explicit
Private Sub myProc2()
Dim wb As Workbook
Dim wsSource As Worksheet
Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Sales")
Dim currLastRow As Long
'Any optimization code could actually go in outer calling sub but consider
'some such as the following
Application.ScreenUpdating = False
Dim copyRow As Range
Dim nm As Variant
For Each nm In ThisWorkbook.Names
If nm.RefersToRange.Parent.Name = "Sales" And nm.Name <> "ITEMName" Then
With wb.Worksheets(nm.Name)
Set copyRow = wsSource.Range(nm.Name).EntireRow
If IsEmpty(.Range("A1")) Then 'First row in sheet is available
.Rows(1).Value = copyRow.Value2
Else
currLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(currLastRow + 1).Value = copyRow.Value2
End If
End With
End If
Next nm
Application.ScreenUpdating = True
End Sub
I have a worksheet that contains multiple tabs that identify different sources of data. I need to combine all the worksheets into one and add a column with the worksheet name as part of the new combined sheet.
I found the following code and if I cut/paste into my worksheet it works like a charm BUT I have several of these workbooks and I have to be able to recreate this process monthly.
My research indicates that I should create a com add in or recallable macro to do this but each time I have tried, the process fails. I would very much appreciate if somone could point me with the steps to do this in Excel (2013) and advise me if my code will work.
Thanks in advance.
Sub Combine()
Dim J As Integer, wsNew As Worksheet
Dim rngCopy As Range, rngPaste As Range
Dim Location As String
On Error Resume Next
Set wsNew = Sheets("Combined")
On Error GoTo 0
'if sheet does not already exist, create it
If wsNew Is Nothing Then
Set wsNew = Worksheets.Add(before:=Sheets(1)) ' add a sheet in first place
wsNew.Name = "Combined"
End If
'copy headings and paste to new sheet starting in B1
With Sheets(2)
Range(.Range("A1"), .Cells(1, Columns.Count).End(xlToLeft)).Copy wsNew.Range("B1")
End With
' work through sheets
For J = 2 To Sheets.Count ' from sheet 2 to last sheet
'save sheet name/location to string
Location = Sheets(J).Name
'set range to be copied
With Sheets(J).Range("A1").CurrentRegion
Set rngCopy = .Offset(1, 0).Resize(.Rows.Count - 1)
End With
'set range to paste to, beginning with column B
Set rngPaste = wsNew.Cells(Rows.Count, 2).End(xlUp).Offset(2, 0)
'copy range and paste to column *B* of combined sheet
rngCopy.Copy rngPaste
'enter the location name in column A for all copied entries
Range(rngPaste, rngPaste.End(xlDown)).Offset(0, -1) = Location
Next J
End Sub
You can add this code into your Personal Macro Workbook, and modify it so it acts on the ActiveWorkbook. That way, when you run it, it will operate on whichever workbook is selected in Excel.
Also worth qualifying all your sheet references with a workbook object reference. When you use (e.g.):
Sheets("Combined")
then by default it will refer to the ActiveWorkbook. Usually this is what you want (though it may not be), but working this way can cause problems if (for example) you open/activate a different workbook in your code, and that other workbook is now the target of your Sheets(....) reference. You resolve this by always being explicit about which workbook you're referring to: for example -
ThisworkBook.Sheets() 'the workbook containing the running code
ActiveWorkbook.Sheets() 'the selected workbook
Workbooks("test.xlsx").Sheets() 'named workbook
wb.Sheets() 'use a variable set to a workbook object
So, modifying your existing code:
Sub Combine()
Dim wb As Workbook
Dim J As Integer, wsNew As Worksheet
Dim rngCopy As Range, rngPaste As Range
Dim Location As String
Set wb = ActiveWorkbook
On Error Resume Next
Set wsNew = wb.Sheets("Combined")
On Error GoTo 0
'if sheet does not already exist, create it
If wsNew Is Nothing Then
Set wsNew = wb.Worksheets.Add(before:=wb.Sheets(1)) ' add a sheet in first place
wsNew.Name = "Combined"
End If
'copy headings and paste to new sheet starting in B1
With wb.Sheets(2)
.Range(.Range("A1"), .Cells(1, Columns.Count) _
.End(xlToLeft)).Copy wsNew.Range("B1")
End With
' work through sheets
For J = 2 To wb.Sheets.Count ' from sheet 2 to last sheet
'save sheet name/location to string
Location = wb.Sheets(J).Name
'set range to be copied
With wb.Sheets(J).Range("A1").CurrentRegion
Set rngCopy = .Offset(1, 0).Resize(.Rows.Count - 1)
End With
'set range to paste to, beginning with column B
Set rngPaste = wsNew.Cells(Rows.Count, 2).End(xlUp).Offset(2, 0)
'copy range and paste to column *B* of combined sheet
rngCopy.Copy rngPaste
'enter the location name in column A for all copied entries
wsNew.Range(rngPaste, rngPaste.End(xlDown)).Offset(0, -1) = Location
Next J
End Sub