why does this code run fine:
Sub SelectRange()
Dim sourceBook As Workbook
Dim sourceSheet As Worksheet
Dim sourceSheetSum As Worksheet
Set sourceBook = ActiveWorkbook
Set sourceSheet = sourceBook.Sheets("Tabelle1")
ActiveWorkbook.Names.Add _
Name:="ggg", _
RefersTo:="=Sheet1!A4:L37"
sourceSheet.Select
sourceSheet.Range("A4:L37").Select
End Sub
However if I change
sourceSheet.Range("A4:L37").Select
to:
sourceSheet.Range("ggg").Select
I receive a run-time error 1004
Try the code below, it will create "ggg" named range from cells "A4:L37" in "Tabelle1" sheet.
Afterwards, it sets another Range MyNamedRange to the named Range("ggg") - this step is not necessary, I just like to work with variables for Range.
At the end, it selects MyNamedRange.
Code
Sub SelectRange()
Dim sourceBook As Workbook
Dim sourceSheet As Worksheet
Dim sourceSheetSum As Worksheet
Dim MyNamedRange As Range
Set sourceBook = ActiveWorkbook
Set sourceSheet = sourceBook.Sheets("Tabelle1")
' create the named range "ggg"
sourceBook.Names.Add _
Name:="ggg", _
RefersTo:="=" & sourceSheet.Name & "!A4:L37"
Set MyNamedRange = Range("ggg") ' <-- set the Range to your NamedRange "ggg"
sourceSheet.Activate '<-- activate the sheet first
MyNamedRange.Select '<-- select the Named Range
End Sub
Try this:
SourceSheet.Range(Names.Item("ggg")).Select
Related
I have this code that opens first workbook, second workbook, copies a range from the first one and pastes it into the second one. I want to make it select the cell right after the pasted range in the second workbook, but it failes with Object required error.
Sub tes()
'**VARIABLES**
Dim folderPath As String
folderPath = "Y:\plan_graphs\final\mich_alco_test\files\"
Dim fileTitle As String
fileTitle = "5.xlsx"
Dim dataWorkbook As Workbook
Set dataWorkbook = Application.Workbooks.Open(folderPath & fileTitle)
Dim copyRange As Range
Set copyRange = dataWorkbook.Worksheets("List1").Range("A3:F3", Range("A3").End(xlDown))
Dim resultWorkbook As Workbook
Set resultWorkbook = Application.Workbooks.Open("Y:\plan_graphs\final\mich_alco_test\result.xlsx")
copyRange.Copy
resultWorkbook.Worksheets("1").Range("A3").PasteSpecial Paste:=xlPasteFormulas
Dim nextRange As Range
Set nextRange = resultWorkbook.Worksheets("1").Range("A3:F3", _
resultWorkbook.Worksheets("1").Range("A3").End(xlDown)).Offset(1, 0).Select
End Sub
What am I doing wrong?
You can't Set the range and Select it in the same line, try the code section below:
copyRange.Copy
With resultWorkbook.Worksheets("1")
.Range("A3").PasteSpecial Paste:=xlPasteFormulas
Dim nextRange As Range
Set nextRange = .Range("A3").End(xlDown).Offset(1, 0) ' set the Range first
nextRange.Select ' <-- select the Range
End With
End Sub
I have 3 sheets and 1 master sheets.
I want to copy cell data in master to rest of the sheets.
It always thrw "Runtime error 1004. can anyone help?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Master")
Dim columnName As String
columnName = Split(ActiveCell.Address, "$")(1)
Sheets.FillAcrossSheets ws.Range(columnName & ActiveCell.Row), xlFillWithAll
End Sub
All sheets should be assigned to array and the range to fill must be from a sheet within the array. Try this
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim shtArray As Variant
shtArray = Array("Master", "Sheet1", "Sheet2", "Sheet3")
Set ws = ThisWorkbook.Sheets("Master")
Sheets(shtArray).FillAcrossSheets Target
'Dim columnName As String
'columnName = Split(ActiveCell.Address, "$")(1)
'Sheets(shtArray).FillAcrossSheets ws.Range(columnName & ActiveCell.Row), xlFillWithAll
End Sub
I am trying to copy over values from one workbook to another using the usedrange function (there are some blanks in certain rows and it is fine to copy over the blank as well), but I am getting the 1004 error:
Sub ActiveInactiveVendors()
Dim ActiveWkb As Workbook, Wkb As Workbook, InactiveWkb As Workbook
Dim ActiveWkst As Worksheet, Wkst As Worksheet, InactiveWkst As Worksheet
Dim aCell As Range
Dim targetRng As Range
Set ActiveWkb = Workbooks.Open("C:\Users\clara\Desktop\active vendors.xlsx")
Set Wkb = ThisWorkbook
Set Wkst = Wkb.Sheets("Vendors")
Set ActiveWkst = ActiveWkb.Worksheets("aqlc7da48e7")
'set column A starting from A7
Set targetRng = Wkst.Range("A7" & Wkst.Rows.Count)
'get the values starting from a32 to the last row used and set it in wkst
targetRng.Value = ActiveWkst.Range("A32" & ActiveWkst.UsedRange.Rows.Count).Value
End Sub
I appreciate any feedback! Thank you
This line:
Set targetRng = Wkst.Range("A7" & Wkst.Rows.Count)
is not correct. You are not getting A7:A1048576 but a concatenating of the two. So it is looking for A71048576 which does not exist
Then you should use similar sized ranges when setting values.
Sub ActiveInactiveVendors()
Dim ActiveWkb As Workbook, Wkb As Workbook, InactiveWkb As Workbook
Dim ActiveWkst As Worksheet, Wkst As Worksheet, InactiveWkst As Worksheet
Dim aCell As Range
Dim targetRng As Range, origRng As Range
Set ActiveWkb = Workbooks.Open("C:\Users\clara\Desktop\active vendors.xlsx")
Set Wkb = ThisWorkbook
Set Wkst = Wkb.Sheets("Vendors")
Set ActiveWkst = ActiveWkb.Worksheets("aqlc7da48e7")
'set column A starting from A7
Set origRng = ActiveWkst.Range("A32", ActiveWkst.Cells(ActiveWkst.Rows.Count, 1).End(xlUp))
Set targetRng = Wkst.Range("A7", Wkst.Cells(origRng.Rows.Count + 6, 1))
'get the values starting from a32 to the last row used and set it in wkst
targetRng.Value = origRng.Value
End Sub
I have the following code which I am trying to get to name the entire A and B columns range according to the worksheet tab name. I want each A:B range of cells in each worksheet to be named RoomCode_ + the name of the excel sheet tab.
So for example if I had 3 sheets called XYZ, ABC and DEF, then my cell range names for those 3 sheets respectively should be:
RoomCode_XYZ
RoomCode_ABC
RoomCode_DEF
I would typically do this manually by highlighting the cell range and just typing the range name I wanted, however I have over 150 tabs and would like to be able to do them all automatically through this process.
Sub nameRanges()
Set wbook = ActiveWorkbook
For Each sht In wbook.Worksheets
sht.Activate
RangeName = "RoomCode_" + ActiveSheet.Name
CellName = "A:B"
Set cell = ActiveWorksheets.Range(CellName)
ActiveWorksheets.Names.Add Name:=RangeName, RefersTo:=cell
Next sht
End Sub
Just a bit of refactoring to get what you need. Biggest this to work directly with objects and eliminate the Active... stuff.
Also ActiveWorksheets is not proper syntax in any way.
Sub nameRanges()
Dim wbook As Workbook
Set wbook = ThisWorkbook
Dim sht As Worksheet
For Each sht In wbook.Worksheets
Dim RangeName As String, CellName As String
RangeName = "RoomCode_" + sht.Name
CellName = "A:B"
Dim cell As Range
Set cell = sht.Range(CellName)
sht.Names.Add Name:=RangeName, RefersTo:=cell
Next sht
End Sub
Here's another way:
Option Explicit
Sub nameRanges()
Dim sht As Worksheet
Dim RangeName As String
Dim cell As String
For Each sht In ActiveWorkbook.Worksheets
RangeName = "RoomCode_" + sht.Name
cell = "=" & sht.Name & "!" & "A:B"
Names.Add Name:=RangeName, RefersTo:=cell
Next sht
End Sub
I think that you would want to add the names to the workbook names collection. The way it is now you'll still have to reference the individual worksheet before you can access the name.
WorkSheets("RoomCode").Range("RoomCode_XYZ")
By adding the names to the workbook you'll be able to access no matter the ActiveSheet.
Range("RoomCode_XYZ")
Sub nameRanges()
Dim wbook As Workbook
Set wbook = ThisWorkbook
Dim sht As Worksheet
For Each sht In wbook.Worksheets
Dim RangeName As String, CellName As String
RangeName = "RoomCode_" + sht.Name
CellName = "A:B"
Dim cell As Range
Set cell = sht.Range(CellName)
ThisWorkBook.Names.Add Name:=RangeName, RefersTo:=cell
Next sht
End Sub
The problem: I am trying to copy data from one workbook to another.
Lets say I have a workbook (called DATA) with several worksheets filled with data. Each column of data has a unique heading (all headings on the same row).
On the other hand I have another workbook (called REPORT) with one worksheet that contains only the heading of the data (in one row). They are not in the same order as in DATA workbook. For example I have 3 headings in REPORT worksheet that can be found in different worksheets in DATA workbook.
I need to loop through all the worksheets in the DATA workbook and copy paste the whole column to the REPORT worksheet when the same heading is found.
This image may help to understand. Explanation
My first attempt:
Dim MyFile As String
Dim ws As Worksheet
''Workbook that contains one worksheet with all the headings ONLY NO DATA
Dim TargetWS As Worksheet
Set TargetWS = ActiveSheet
Dim TargetHeader As Range
''Location of Headers I want to search for in source file
Set TargetHeader = TargetWS.Range("A1:G1")
''Source workbook that contains multiple sheets with data and headings _
not in same order as target file
Dim SourceWB As Workbook
Set SourceWB = Workbooks("Source.xlsx")
Dim SourceHeaderRow As Integer: SourceHeaderRow = 1
Dim SourceCell As Range
''Stores the col of the found value and the last row of data in that col
Dim RealLastRow As Long
Dim SourceCol As Integer
''Looping through all worksheets in source file, looking for the heading I want _
then copying that whole column to the target file I have
For Each ws In SourceWB.Sheets
ws.Activate
For Each Cell In TargetHeader
If Cell.Value <> "" Then
Set SourceCell = Rows(SourceHeaderRow).Find _
(Cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not SourceCell Is Nothing Then
SourceCol = SourceCell.Column
RealLastRow = Columns(SourceCol).Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
If RealLastRow > SourceHeaderRow Then
Range(Cells(SourceHeaderRow + 1, SourceCol), Cells(RealLastRow, _
SourceCol)).Copy
TargetWS.Cells(2, Cell.Column).PasteSpecial xlPasteValues
End If
End If
End If
Next
Next
I am getting an error of Application-defined or object-defined error Run-time 1004. Is there something wrong with my logic/syntax..?
Please help I am so bad in VBA.
Thanks in advance!
your last edited code works
but you're making unnecessary checks and I'd suggest you to loop through each sheet header and check if it exists in TargetHeader range to possibly subsequently copy its column to SourceWB
furthermore you may want to have your code more robust and check for actual wanted workbooks/worksheets existence before attempting to set variables to them
like follows:
Option Explicit
Sub main()
Dim SourceWB As Workbook
Dim ws As Worksheet, TargetWS As Worksheet
Dim TargetHeader As Range, cell As Range, SourceCell As Range
Dim SourceHeaderRow As Integer: SourceHeaderRow = 1
''Source workbook that contains multiple sheets with data and headings _
not in same order as target file
Set SourceWB = GetWb("Source.xlsx")
If SourceWB Is Nothing Then Exit Sub
''Workbook that contains one worksheet with all the headings ONLY NO DATA
'Set TargetWS = ActiveSheet
Set TargetWS = GetWs("REPORT") 'it will get the first worksheet (if any) in "REPORT" workbook (if open)
If TargetWS Is Nothing Then Exit Sub
''Location of Headers I want to search for in source file
Set TargetHeader = TargetWS.Range("A1:G1")
''Looping through all worksheets in source file, looking for the heading I want _
then copying that whole column to the target file I have
For Each ws In SourceWB.Sheets
For Each cell In ws.Rows(SourceHeaderRow).SpecialCells(xlCellTypeConstants, xlTextValues)
Set SourceCell = TargetHeader.Find(cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not SourceCell Is Nothing Then
Range(cell.Offset(1), ws.Cells(ws.Rows.Count, cell.Column).End(xlUp)).Copy
SourceCell.Offset(1).PasteSpecial xlPasteValues
End If
Next
Next
End Sub
Function GetWb(wbName As String) As Workbook
On Error Resume Next
Set GetWb = Workbooks(wbName)
On Error GoTo 0
If GetWb Is Nothing Then MsgBox "Sorry, the workbook '" & wbName & "' isn't open" & vbCrLf & vbCrLf & "Please open it and run the macro again"
End Function
Function GetWs(wbName As String, Optional wsName As Variant) As Worksheet
Dim wb As Workbook
Dim ws As Worksheet
Set wb = GetWb(wbName)
If wb Is Nothing Then Exit Function
On Error Resume Next
If IsMissing(wsName) Then
Set GetWs = wb.Worksheets(1) ' if no ws name passed then get the first one
Else
Set GetWs = wb.Worksheets(wsName)
End If
On Error GoTo 0
If GetWs Is Nothing Then MsgBox "Sorry, the worksheet '" & wsName & "0 isn't in '" & wb.Name & "'" & vbCrLf & vbCrLf & "Please open a valid workbook and run the macro again"
End Function