I want to loop the below code on all sheets that contain "12MN" in the sheet name. The code is currently built to just run on the one sheet. If there's a cleaner code of what I already have, that'd be great too. TIA.
Sub TransferValuesOnly()
Dim rng As Range
'Grab Some Data and Store it in a "Range" variable
Set rng = Worksheets("John Smith 12MN").Range("B7:R18")
'Transfer Values to same spot in another worksheet (Mimics PasteSpecial Values Only)
Worksheets("John Smith 12MN").Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
'Grab Some Data and Store it in a "Range" variable
Set rng = Worksheets("John Smith 12MN").Range("B24:R35")
'Transfer Values to same spot in another worksheet (Mimics PasteSpecial Values Only)
Worksheets("John Smith 12MN").Range("B23").Range("B23").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
End Sub
Add a Worksheet loop
Check name with InStr
Swap your hardcoded sheet references with the loop sheet reference (ws)
Dim rng As Range
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
If InStr(ws.Name, "12MN") Then
Set rng = ws.Range("B7:R18")
ws.Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
End If
Next ws
Related
I have two Excel workbooks.
First Workbook has two sheets: "Sales" and "Lookup".
Second Workbook has one sheet: "ID"
From the first workbook (Sales), I have to read column 'B' values, search it in column A of "Lookup" sheet and get name from column B.
After fetching ID, I have to write to column E of "ID" workbook.
I tried the first part, but it is not iterating through the cells of Sales and not picking value from "Lookup".
Sub btnExport_Click()
Dim rng As Range
Dim ws1, ws2 As Worksheet
Dim MyStringVar1 As String
Set ws1 = ThisWorkbook.Sheets("Lookup")
Set ws2 = ThisWorkbook.Sheets("Sales")
Set rng = ws2.Range("B2")
With ws2
On Error Resume Next 'add this because if value is not found, vlookup fails
MyStringVar1 = Application.WorksheetFunction.VLookup(Left(rng, 6), ws1.Range("A2:C65536").Value, 2, False)
On Error GoTo 0
If MyStringVar1 = "" Then MsgBox "Item not found" Else MsgBox MyStringVar1
End With
End Sub
*** Edited ***
Code fixed. It is now reading from first cell of Sales but not iterating. Also, while iterating and fetching from Lookup, it has to write to another workbook. This I am not able to fix.
There are two changes that you should make to start. First, try not to reference ActiveSheet (as mentioned in the comments). If the macro is run while a different sheet is selected, then it will mess things up. Store the appropriate worksheet in a variable, such as:
Dim ws As Worksheet
Set ws = Sheets("Sales")
The other item that stands out is in your loop, you are using the .Cells off of the rng object. In your case, you set rng to be the used range in Column B. Let's assume that's cells B2:B10. When you then say rng.Cells(i, 2), if actually offset to the second column of the range, which starts with Column B. You end up using column C.
Instead, try something like
Sub btnExport_Click()
Dim rng As Range
Dim i As Long
Dim ws As Worksheet
Set ws = Sheets("sales")
With ws
Set rng = .Range("B2:B" & .Cells(.Rows.Count, 1).End(xlUp).Row)
For i = 2 To rng.Rows.Count
.Cells(i, 2) = Application.WorksheetFunction.VLookup(.Cells(i, 1), Sheets("Lookup").Range("A:B"), 2, False)
MsgBox (.Cells(i, 2))
Next
End With
End Sub
In a masterfile I have the worksheet XXXX, which the range C2:C3 contains the names of two tables. I store those names in the array tba which is a variant variable.
Private Sub ORSA_REPORT_Click()
Dim rng As Range
Dim rng2 As Range
Dim SummaryWb As Workbook
Dim tba As Variant
Dim ws As Worksheet
Set SummaryWb = Workbooks.Open("I:\XXX\XXXXX.xlsx") ' <--- I open this workbook
' which contains the tables
' I need to copy
ThisWorkbook.Activate
tba = Worksheets("XXX").Range("C2:C3") ' <--- Please see below a screenshot
' with the names
SummaryWb.Activate
For i = 1 To 2
Set rng = Range(tba(i, 1)) ' <--- in the tba are names which i take them from
' the masterworkbook but i want to use them
' in the workbook whichg contains the tables
rng.Copy
SummaryWb.Worksheets("New").Cells(i, 1).PasteSpecial xlPasteAll
Next i
I want to activate the SummaryWb and use the names from the tba in the SummaryWb to define the rng which is a range variable.
I made an extensive research but I could not figure it out.
Example:
The first name range which is in the masterworkbook is Name1
The second name range which is in the masterworkbook is Name2
--> Please note that only the names are in that file.
Next the actual range is in the other workbook. For example:
In workbook2 I have the A1:B5 named as Name1 and C1:D5 named as Name2.
I store the two names from the workbook1 in an array, the tba.
I want to set the rng to be equal with the ranges represented by the entries of the tba.
Don't use .Activate instead specify workbook and worksheet for every range object. If you do that it is clear what happens.
Private Sub ORSA_REPORT_Click()
Dim SummaryWb As Workbook
Set SummaryWb = Workbooks.Open("I:\XXX\XXXXX.xlsx")
Dim tba As Variant
tba = ThisWorkbook.Worksheets("XXX").Range("C2:C3").Value
'eg tba is then:
'tba(1, 1) = "Name1"
'tba(2, 1) = "Name2"
For i = 1 To 2
Dim rng As Range
Set rng = Workbooks("Workbook2").Worksheets("SheetName").Range(tba(i, 1))
rng.Copy
SummaryWb.Worksheets("New").Cells(i, 1).PasteSpecial xlPasteAll
Next i
End Sub
So make sure for every Range object that you specify which workbook/worksheet it is in. If it is in the workbook the VBA code is in then you can use ThisWorkbook instead of Workbooks("NameOfWorkbook").
Note that if you use Set rng = Workbooks("Workbook2").Worksheets("SheetName").Range(tba(i, 1)) then the named ranges Name1 and Name2 must exist in worksheet SheetName of Workbook2.
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!
I have a workbook with about 63 sheets. I'd like to take all filtered data (filtered by a macro) from all worksheets and paste them into a separate worksheet.
Worksheets DON'T have the same data range. They all would start on Column A Row 15 IF there is any data there at all. The filter macro filters for specific values in one of the columns hence the differentiation between rows in each sheet.
I need to copy all filtered data starting with a Range of A15 and the last row in the range would be AI. It's just a matter of how many rows if there are any rows to get the number for the AI in the range to copy over.
I got it to copy an entire sheet, not the filtered data, to another sheet but it only copied sheet 1.
Sub rangeToNew_Try2()
Dim newBook As Excel.Workbook
Dim rng As Excel.Range
Set newBook = Workbooks.Add
Set rng = ThisWorkbook.Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeVisible)
rng.Copy newBook.Worksheets("Sheet1").Range("A1")
End Sub
You can use Worksheet.UsedRange to give you just the Range with data in, then you could apply your Range.SpecialsCells to give you just the filtered data.
To help debug your code, set a breakpoint and use the Immediate Window to see what the range is, i.e.:
?rng.Address
(The question mark prints out whatever follows.)
This function should do what you need:
Sub CopyFilteredDataToNewWorkbook()
Dim newBook As Excel.Workbook
Dim rng As Excel.Range
Dim sht As Excel.Worksheet
Dim rowoffsetcount As Long
Dim newsht As Excel.Worksheet
Set newBook = Workbooks.Add
' ThisWorkbook.Worksheets is the same as the Sheets or Worksheets object, but more explicit
For Each sht In ThisWorkbook.Worksheets
' Get the used rows and columns
Set rng = sht.UsedRange
' Offset the range so it starts at row 15
rowoffsetcount = 15 - rng.Row
Set rng = rng.Offset(rowoffsetcount)
' Check there will be something to copy
If (rng.Rows.Count - rowoffsetcount > 0) Then
' Reduce the number of rows in the range so it ends at the same row
Set rng = rng.Resize(rng.Rows.Count - rowoffsetcount)
' Check that there is a sheet we can copy it to
On Error Resume Next
Set newsht = Nothing
Set newsht = newBook.Worksheets(sht.Index)
On Error GoTo 0
' We have run out of sheets, add another at the end
If (newsht Is Nothing) Then
Set newsht = newBook.Sheets.Add(, newBook.Worksheets(newBook.Worksheets.Count))
End If
' Give it the same name
newsht.Name = sht.Name
' Get the range of visible (i.e. unfiltered) rows
' (can't do this before the range resize as that doesn't work on disjoint ranges)
Set rng = rng.SpecialCells(xlCellTypeVisible)
' Paste the visible data into the new sheet
rng.Copy newsht.Range("A1")
End If
Next
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