My code finds user defined values in an active worksheet, selects, copies them, and then paste them into a separate worksheet. When I incorporate a loop to iterate over a list of values and copy the results into separate tabs the code breaks. The error Object variable not set (Error 91).
Any thoughts?
Sub copy_paste_sheet_names3()
'declare variables
Dim mainworkBook As Workbook
Set mainworkBook = ActiveWorkbook
Dim sheet_name As String
Dim ws As Worksheet
Dim SelectCells As Range
Dim xcell As Object
Set ws = Worksheets("MasterData")
'check each cell in the specific worksheet if the criteria is matching
For i = 1 To mainworkBook.Sheets.Count
sheet_name = mainworkBook.Sheets(i).Name
For Each xcell In ws.UsedRange.Cells
If xcell.Value = sheet_name Then
If SelectCells Is Nothing Then
Set SelectCells = Range(xcell.Address)
Else
Set SelectCells = Union(SelectCells, Range(xcell.Address))
End If
End If
Next
'select the cells with specified value
SelectCells.EntireRow.Select
SelectCells.EntireRow.Copy
Sheets(sheet_name).Select
Range("A1").Select
ActiveSheet.Paste
ws.Select
Next i
End Sub
Related
I am trying to hide the activecell column across first 4 tabs. The vba below does not seem to be working. It only hides the activecell in first tab in activesheet. So basically I select highlight first 4 tabs and select cell A1 then use below code:
ActiveCell.EntireColumn.Hidden = True
This only hides column A in first tab, but not tab 2,3,4. Can someone please help get the correct code? Just fyi...it has to be the selected cell and not Range("A1").EntireColumn.Hidden = True, because cell can be any active cell I am trying to hide using an offset function. Any help is appreciated. Thanks.
You could store the location of the active cell, then cycle through each worksheet and use that location to base your column hiding..
Sub tested()
Dim cell_address As String
Dim wsName, ws, c As Range
cell_address = ActiveCell.Address
wsName = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")
For Each ws In wsName
Sheets(ws).Range(cell_address).EntireColumn.Hidden = True
Next
End Sub
Hide the Same Column in Different Worksheets
There is no way to combine (select) cells from multiple worksheets at the same time so you need to loop through the worksheets and hide each column separately, one after the other.
Usage
Sub HideCellColumnsTEST()
Dim wsIDs(): wsIDs = Array(1, 2, 3, 4)
Dim ws As Worksheet: Set ws = ActiveSheet
Dim cell As Range: Set cell = ws.Range("A1")
'or:
'Set cell = ActiveCell
'Set cell = ActiveCell.Offset(, 3) '...etc.
HideCellColumns cell, wsIDs
End Sub
The Method
Sub HideCellColumns(ByVal cell As Range, ByVal wsIDs As Variant)
Dim CellAddress As String: CellAddress = cell.Address
Dim wb As Workbook: Set wb = cell.Worksheet.Parent
Dim ws As Worksheet, wsID
For Each wsID In wsIDs
On Error Resume Next
Set ws = wb.Worksheets(wsID)
On Error GoTo 0
If Not ws Is Nothing Then ' worksheet exists
ws.Range(CellAddress).EntireColumn.Hidden = True
Set ws = Nothing ' reset for the next iteration
'Else ' worksheet doesn't exist; do nothing!?
End If
Next wsID
End Sub
I'm trying to create a new sheet labeled with a different identifier from a range and also have two cells from other ranges included on each update. I can get the new sheets to create with a different label from a range, and have the first cell in the second range (xRg2) added to each subsequent sheet, but haven't been successful at iterating through the second range. I know I need another loop somewhere but my last nest created way too many sheet. See example below
Sub Add()
Dim xRg As Excel.Range
Dim xRg2 As Excel.Range
Dim wSh As Excel.Worksheet
Dim wBk As Excel.Workbook
Dim wSh2 As Excel.Worksheet
Dim wSh3 As Excel.Worksheet
Set wSh = ActiveSheet
Set wBk = ActiveWorkbook
Set wSh2 = ThisWorkbook.Sheets("List")
Set wSh3 = ThisWorkbook.Sheets("Template")
Set xRg2 = wSh2.Range("G66:G88")
Application.ScreenUpdating = False
For Each xRg In wSh2.Range("B66:B88")
With wBk
wSh3.Copy after:=.Sheets(.Sheets.Count)
On Error Resume Next
wSh.Name = xRg.Value
wSh.Cells(33,7) = xRg2.Value
If Err.Number = 1004 Then
Debug.Print xRg.Value & "already used as a sheet name"
End If
On Error GoTo 0
End With
Next xRg
Application.ScreenUpdating = True End Sub
So, to summarize, the goal here is to input the ranges into the code each time and have each new sheet include the first values from each range, then the second sheet the second values from each range, and so on until the xRg is at the end of it's list. I know there's only two ranges down here but the total will be 3. Also apologies on the poor variable discipline...
Thanks!
Try something like this (sorry do not like all those x... variable names)
Sub Add()
Dim c As Range
Dim wb As Workbook, ws As Worksheet, wsList As Worksheet
Set wb = ActiveWorkbook
Set wsList = wb.Worksheets("List")
Application.ScreenUpdating = False
For Each c In wsList.Range("B66:B88").Cells
ThisWorkbook.Sheets("Template").Copy after:=wb.Sheets(wb.Sheets.Count)
Set ws = wb.Sheets(wb.Sheets.Count) '<< get the just-created sheet copy
On Error Resume Next
ws.Name = c.Value
ws.Cells(33, 7) = c.EntireRow.Columns("G").Value
If Err.Number = 1004 Then
Debug.Print "'" & c.Value & "' already used as a sheet name"
End If
On Error GoTo 0
Next c
Application.ScreenUpdating = True
End Sub
I would like to select multiple cells based on selection.
And here is my code:
Private Sub CommandButton1_Click()
Selection.EntireRow.Select
End Sub
I want to select the first four columns of rows in multiple cells, instead of the whole rows. How to achieve it?
this is my Excel worksheet
Select Rows of Non-Contiguous Range
Copy the codes into a standard module e.g. Module1.
In your command button click event use either of the procedure names in the following way:
Private Sub CommandButton1_Click()
selectRowsOfListObject
End Sub
or
Private Sub CommandButton1_Click()
selectRowsOfFirstFourColumns
End Sub
The first procedure will select only the rows of the selected cells in the first (structured) table in the ActiveSheet. Any cells outside the data of the table (DataBodyRange) will be ignored.
The second procedure will select all the row ranges of the selected cells in the first four columns, in the first four columns of the ActiveSheet. Any cells selected outside of the first four columns will be ignored
Each or both of the codes can be used with command buttons on any worksheet when they will refer to the worksheet 'containing' the command button.
If you want a command button on another worksheet to always refer to the first, you will rather have to create a reference to the first worksheet:
Instead of
Set ws = ActiveSheet
use e.g.
Set ws = wb.Worksheets("Sheet1")
To better understand the differences, you could add another command button for the second code and then test each of them.
The Code
Option Explicit
Sub selectRowsOfListObject()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = ActiveSheet
Dim tbl As ListObject
Set tbl = ws.ListObjects(1)
If Selection.Worksheet.Name = ws.Name Then
If TypeName(Selection) = "Range" Then
Dim rng As Range
Set rng = Intersect(Selection, tbl.DataBodyRange)
If Not rng Is Nothing Then
Set rng = Intersect(rng.Rows.EntireRow, tbl.DataBodyRange.Rows)
End If
If Not rng Is Nothing Then
rng.Select
End If
End If
End If
End Sub
Sub selectRowsOfFirstFourColumns()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = ActiveSheet
If Selection.Worksheet.Name = ws.Name Then
If TypeName(Selection) = "Range" Then
Dim rng As Range
Set rng = Intersect(Selection.Rows.EntireRow, _
ws.Columns(1).Resize(, 4))
If Not rng Is Nothing Then
rng.Select
End If
End If
End If
End Sub
Check this code:
Option Explicit
Sub Rows_Selection()
Dim rng As Range
Dim active_cells_adress, row_no As Variant
Dim final_selection_adress As String
Dim rng1 As String
Dim i As Integer
Selection.EntireRow.Select
Set rng = Selection
rng1 = rng.Address
final_selection_adress = ""
active_cells_adress = Split(rng1, "$")
For i = 2 To UBound(active_cells_adress)
row_no = Split(active_cells_adress(i), ",")
final_selection_adress = final_selection_adress + "A" & row_no(0) & ": D" & row_no(0) + ","
i = i + 1
Next
final_selection_adress = Left(final_selection_adress, Len(final_selection_adress) - 1)
Range(final_selection_adress).Select
End Sub
I have an excel file with a list of names(names.xlsm), I want to create another new excel file(separate.xlsx) with different sheets. The name of each sheet in separate.xlsx is a name in names.xlsx and the first cell of each sheet is the same name value.
'''VBA
Sub copy_name()
Dim MyCell As Range, MyRange As Range, ws As Worksheet
Dim mybook As Workbook
Set mybook = Workbooks("names.xlsm")
Set MyRange = mybook.Sheets("names").Range("A2:A6") 'eg. five names'
Dim target As Workbook
Set target = Workbooks("separate.xlsx")
i = 1
For Each MyCell In MyRange
Set ws = target.Worksheets.Add(After:=Worksheets(Worksheets.Count)) ' create new worksheet in target file
ws.Name = MyCell.Value ' renames the new worksheet
target.Sheets(MyCell.Value).Cells(1, 1) = MyCell 'copy the value of Mycell to target sheets
i = i + 1
Next
Set mybook = Nothing
Set target = Nothing
End Sub
'''
Here is my code. It keeps showing errors and I do not know how to debug.
You can create the worksheet and name it in one line. No need to create it and then name it.
You need to fully qualify your objects
I am assuming that the workseets with the same name as in the names.xlsm do not exist in separate.xlsx. If it does then you will have to handle that separately.
Is this what you are trying?
Option Explicit
Sub Sample()
Dim wbNames As Workbook, wbSep As Workbook
Dim rng As Range, aCell As Range
Set wbNames = Workbooks("names.xlsm")
Set wbSep = Workbooks("separate.xlsx")
Set rng = wbNames.Sheets("Names").Range("A2:A6")
For Each aCell In rng
With wbSep
.Sheets.Add(After:=.Worksheets(.Worksheets.Count)).Name = aCell.Value
.Worksheets(aCell.Value).Cells(1, 1).Value = aCell.Value
End With
Next
End Sub
I'm currently doing VBA project which need to copy from a workbook to another, which the WBookPst is the workbook I firstly open (use) meanwhile WBookCopy is the workbook where I open based on the links where I got by listing all ".xslt" format in a File into my Sheet1 of my first workbook. Here is my code :
Sub SortFiles()
'Set up your variables and turn off screen updating.
'Dim iCounter As Integer
Application.ScreenUpdating = False
'Sort the rows based on the data in column C
Columns("A:C").Sort key1:=Range("C2"), _
order1:=xlDescending, Header:=xlYes
Application.ScreenUpdating = True
Dim WBookCopy As Workbook
Dim WBookPst As Workbook
Dim filePath As String
Dim sheetName As String
Dim sheetCopy As Worksheet
Dim sheetPate As Worksheet
Dim rngCopy As Range
Dim rngPst As Range
filePath = Range("B2").Value
Set WBookCopy = Workbooks.Open(filePath)
Columns(30).Insert
For i = 1 To Sheets.count
Cells(i, 30) = Sheets(i).Name
Next i
sheetName = Range("AD1").Value
Set sheetCopy = WBookCopy.Worksheets(sheetName)
Set rngCopy = sheetCopy.Range("A:AA").Copy
Set WBookPst = ThisWorkbook
Set sheetPaste = WBookPst.Worksheets("Sheet1").Activate
Set rngCopy = sheetPaste.Range("A:AA").Select
ActiveSheet.Paste
End Sub
At Set rngCopy = sheetCopy.Range("A:AA").Copy there's error "Objects required".
What does that mean?
By the way, is how I copy and paste the data between sheets correct?
The issue is that rngCopy is of type range and you can't set it equal to a method (copy). Remove the .Copy and you should be fine. You also don't need to set the worksheet out range to a variable. You could just do one line that says WBookCopy.SheetName.Range("A:AA").Copyand then another line to paste.
As #Wyatt mentioned - your copy\paste syntax is incorrect
Here are 2 ways to do it:
Worksheets("Sheet1").Range("A:AA").Copy
Worksheets("Sheet2").Range("A1").PasteSpecial xlPasteAll
or
Worksheets("Sheet1").Range("A:AA").Copy Destination:=Worksheets("Sheet2").Range("A1")