I am working on a macro in which, when I press one button in a workbook, the code is executed on another workbook. The is already working if I execute it from a unique workbook, but I can’t make it work with the button from an external workbook and I am not sure when and how to reference correctly.
This is the code, where I try to insert a row at the top, insert the Column function and drag it until the end:
Private Sub CommandButton1_Click()
Dim lastColumn As Integer
Dim rng_source As Range
Dim rng_Destination As Range
Dim l_SourceRows As Long
Set ws = Workbooks("TEST")
ws.Activate
ActiveSheet.Name = "Sheet1"
' Insert row and formula
ws.Worksheets("LV").Activate
ws.Sheets("LV").Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Sheets("LV").Range("A1").Select
ActiveCell.FormulaR1C1 = "=COLUMN(C)"
' Drag formula until last column
Set rng_source = ws.Sheets("LV").Range("A1")
l_SourceRows = rng_source.Rows.Count
lastColumn = ws.Sheets("LV").Cells(2, Columns.Count).End(xlToLeft).Column
Set rng_Destination = ws.Sheets("LV").Range(rng_source.Cells(1), Cells(rng_source.Cells(1), lastColumn))
rng_source.AutoFill Destination:=rng_Destination, Type:=xlFillDefault
End Sub
leaving the rest of your code alone for now, what the following does is, set "ws" to mean the workbook named "TEST" (it needs to be already open, I think). You then activate it and give what ever sheet you are on the name "Sheet1". After that you activate the worksheet "LV" in that "TEST" worksheet. I am not sure what you are trying to do with those steps?
Set ws = Workbooks("TEST")
ws.Activate
ActiveSheet.Name = "Sheet1"
' Insert row and formula
ws.Worksheets("LV").Activate
ws.Sheets("LV").Rows("1:1").Select
I assume you want to press a button, open another sheet and then do your code on that sheet? How about you simply copy your whole code, make a new sub and then change the set line to something that opens the other workbook? Like so Maybe:
Sub test()
Dim lastColumn As Integer
Dim rng_source As Range
Dim rng_Destination As Range
'Filepath of the file in some cell on the workbook (Pick one)
FilePath = ThisWorkbook.Sheets("NameOfTheSheet").Range("B2").Value
'Filepath of the file hard coded in here, simply copy the path and name (Pick one)
FilePath = "C:\Users\TheMan\Desktop\Test.xlsx"
'Open the file
Set ws = Workbooks.Open(FilePath, ReadOnly:=False)
'Now you do everything with the other workbook that you did to "ws" before.
'Not sure you really need/want this.
ws.Activate
ActiveSheet.Name = "Sheet1"
'Insert row and formula
ws.Worksheets("LV").Rows(1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Worksheets("LV").Range("A1").FormulaR1C1 = "=COLUMN(C)"
' Drag formula until last column
lastColumn = ws.Worksheets("LV").Cells(2, Columns.Count).End(xlToLeft).Column
Set rng_source = ws.Sheets("LV").Range("A1")
Set rng_Destination = ws.Sheets("LV").Range(rng_source.Cells(1), Cells(rng_source.Cells(1), lastColumn))
rng_source.AutoFill Destination:=rng_Destination, Type:=xlFillDefault
End Sub
To be honest I dont quite understand what you are trying to do with your code. I`m using a German Excel tho and for me, the formula "=COLUMN(C)" basically just numbers the first row. Also you Set the Range("A1") and then ask for the row of that range. Why? its always 1 and never gets used. But if for some other reason you really need to drag it, see the edited code.
Related
In cell K2 in first workbook is written today's date which is the reference for the name of other workbook. I need to take some information from a second open workbook whose file name is today's date ("13.06.2021.xlsx").
I created variable second_workbook which is the date. Then I created variable called "cellscopy" (active cell from first workbook and to copy 3 more cells to the right of it). Then the macro pastes a value in cell I2 in the first workbook (there's a formula in J2 rearranging the account number) and then J2 is the criteria for filter from a third workbook called "Bank accounts.xlsx".
My macro then finds the value from first workbook cell J2 ("criteria") from "Bank accounts.xlsx" in columns I:I and copies a value 5 columns leftward from that cell - a bank acc number corresponding to that batch number.
I created a variable "accnumber" which is then pasted in a filter in a table in the second workbook ("13.06.2021.xlsx"). Then the filtered range from the table is copied and pasted in a new workbook (NewWb) in cell A12. Then I need to go back to the first workbook and copy the "cellscopy" range and paste it again in the new workbook which was created at cell C7.
However, I get a run-time error 438 Object doesn't support this property or method highlighting the last line of my VBA code.
Can you please help me with this issue? I hope I could explain you as clear as possible my problem.
second_workbook = Range("K2").Value
Dim wb As Workbook
Dim actWb As Workbook, newWb As Workbook, shAct As Worksheet, shNew As Worksheet
Dim cellscopy As Range
Set cellscopy = Range(ActiveCell, ActiveCell.Offset(0, 3))
Set actWb = ActiveWorkbook
Set shAct = actWb.Sheets(1)
Set newWb = Workbooks.Add
Set shNew = newWb.Sheets(1)
Set wb = Workbooks(Format(second_workbook, "dd.mm.yyyy") & ".xlsx")
Dim batchnumber As Range
Selection.Copy
Range("I2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Criteria = Range("J2").Value
Windows("Bank Accounts.xlsx").Activate
Set batchnumber = Range("I:I").Find(Criteria & "TT")
If Not batchnumber Is Nothing Then
batchnumber.Select
End If
ActiveCell.Offset(0, -5).Range("A1").Select
accnumber = ActiveCell
wb.Activate
ActiveSheet.Range("$A$1:$G$654").AutoFilter Field:=5, Criteria1:=accnumber
Range("C1").Activate
Selection.CurrentRegion.Select
Application.CutCopyMode = False
Selection.Copy
newWb.Activate
Range("A12").Select
ActiveSheet.Paste
shAct.Range(cellscopy).Copy Destination:=newWb.Range("C7:F7")
I am getting error 438 at the last line.
I hope I explained as clear as possible my issue. If you could help me I would appreciate it very much
When creating a new workbook, set it as a variable when doing so.
This way it's easy to refer to it.
Dim wb As Workbook
Set wb = Workbooks.Add
I'm also obliged to link to the how to avoid using select post.
edit
Now that you completely changed the question, the rest of this doesn't make much sense.
Please, try the next code. You need to understand that you cannot paste IN A WORKBOOK. You should paste in a sheet range:
Sub testCopyFilterCopy()
Dim shAct As Worksheet, wb2 As Workbook, sh2 As Worksheet, wb3 As Workbook, sh3 As Worksheet
Dim value_for_filter As String, actCell As Range, rngFilt As Range, rngF As Range
Set shAct = ActiveSheet
Set actCell = ActiveCell
value_for_filter = actCell.value
Set wb2 = Windows(Format(Date, "dd.mm.yyyy") & ".xlsx")
Set sh2 = wb2.Worksheets("My sheet") 'Plese use here the appropriate sheet name!!!
Set rngFilt = sh2.Range("$A$1:$G$654")
rngFilt.AutoFilter field:=5, Criteria1:=value_for_filter
On Error Resume Next
'set a range of the filtered cells only:
Set rngF = rngFilt.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rngF Is Nothing Then
Set wb3 = Workbooks.Add
Set sh3 = wb3.Worksheets(1)
rngF.Copy Destination:=sh3.Range("A12")
shAct.Range(actCell, actCell.Offset(0, 3)).Copy Destination:=sh3.Range("C10")
Else
MsgBox "No visible cells in the range..."
End If
End Sub
You can paste only in a sheet, not in a workbook
If you want to copy the filtered range, you need to use VisibleCells. Otherwise, all the range will be pasted, not only the filtered one.
You should put Option Explicit on top of your module, in order to be obliged to declare all variables.
I am trying to copy a select range of cells from one workbook into another. This is my select range and copy code so far used in the first workbook:
Sub Copy()
'This selects the range of active cells, adds a border and copies all data.
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
End Sub
While this selects and copies the cells in the 1st workbook, I am having difficulties incorporating it with a macro that pastes it into another workbook. Here is a sample of a macro that pastes data from one workbook into another:
Sub Paste()
Dim x As Workbook
Dim y As Workbook
'## Open both workbooks first:
Set x = Workbooks.Open(" path to copying book ")
Set y = Workbooks.Open(" path to destination book ")
'Now, transfer values from x to y:
y.Sheets("sheetname").Range("A1").Value = x.Sheets("name of copying sheet").Range("A1")
'Close x:
x.Close
End Sub
Two things:
The 1st workbook with the initial data is not a saved document on my computer. It's an exported sheet from the internet I am trying to paste into a saved workbook on my computer. Therefore, I don't think a file path or worksheet name for the first workbook is possible to get.
I am hoping to paste the data in the first available blank cell in column A of the second workbook. I believe the code for that is something like: CurrentRow = Range("A1").End(xlDown).Offset(1, 0).Row and then obviously paste into that row starting in the A column.
Can someone help me incorporate these two codes into one?
Thank you very much!
Here are two snippets of code I have used in recent times which should help you in your predicament.
This first code allows you to find a specific worksheet by name (or index as stated by Office Documentation). This does not need you to specify the workbook as it loops through all currently open worksheets.
Dim Sheet As Worksheet
Dim sheetName As String
sheetName = "Sheet1"
For Each Sheet In Worksheets
If Sheet.Name = sheetName Then
Set GetSheet = Worksheets(sheetName)
Exit For
End If
Next Sheet
The next Code snippet (I can not take credit for, but have lost info of origin) which will search a specified worksheet for any and all data contained with-in and create a range object with the cell range found.
(This may not be what you want as I am unsure from your question as to if you want all the data or just a selection).
Dim dataRange as Range
Dim lastCol As Long
Dim lastRow As Long
Dim sheetCells As range
Set sheetCells = Sheet.Cells
If WorksheetFunction.CountA(sheetCells) > 0 Then
'Search for any entry, by searching backwards by Rows.
lastRow = sheetCells.Find(What:="*", after:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
' Search for any entry, by searching backwards by Columns.
lastCol = sheetCells.Find(What:="*", after:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
' Set the range from 1st cell of sheet to last cell found to contain data
Set dataRange = Sheet.range(Sheet.Cells(1, 1), Sheet.Cells(lastRow, lastCol))
End If
Once you have a range object, there is a lot you can do with it but to simply insert values into another worksheet:
Dim newSheet as WorkSheet
set newSheet = ThisWorkbook.Worksheets("New Sheet") ' Just an example
'Using fields from last code snippet
newSheet.Range(newSheet.Cells(1,1), newSheet.Cells(lastRow,lastCol)).value = dataRange.Value
In reference to: Copy a row in excel if it matches a specific criteria into a new worksheet
I attempted applying the above hyperlink code to the needs of my own workbook. The only notable differences are: Object names, My data begins in "A2" instead of "A1", and my data is being copied to "L" column in a new worksheet instead of "A" column
Also... you can assume I have generated tabs in excel that correspond with each SelectCell.Value.
Sub Consolidate_Sheets()
Dim MyCell As Range
Dim MyRange As Range
Dim ws As Worksheet
Set MyRange = Sheets("Install_Input").Range("A2")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
Call superSizeMe(MyCell, MyRange)
Sub superSizeMe(SelectCell As Range, SelectRange As Range)
Dim InstallInput As Worksheet
Dim strPasteToSheet As String
'New worksheet to paste into
Dim DestinationSheet As Worksheet
Dim DestinationRow As Range
'Define worksheet with input data
Set InstallInput = ThisWorkbook.Worksheets("Install_Input")
For Each SelectCell In SelectRange.Cells
InstallInput.Select
If SelectCell.Value <> "" Then
SelectCell.EntrieRow.Select ''''LOCATION OF RUN-TIME ERROR 438''''
Selection.Copy
Set DestinationSheet = Worksheets(SelectCell.Value)
Set DestinationRow = DestinationSheet.Range("L1:L" & DestinationSheet.Cells(Rows.Count, "L").End(xlUp).Row)
Range("L" & DestinationRow.Rows.Count + 1).Select
ActiveSheet.Paste
End If
Next SelectCell
InstallInput.Select
InstallInput.Cells(1, 1).Select
If IsObject(InstallInput) Then Set InstallInput = Nothing
If IsObject(SelectRange) Then Set SelectRange = Nothing
If IsObject(SelectCell) Then Set SelectCell = Nothing
If IsObject(DestinationSheet) Then Set DestinationSheet = Nothing
If IsObject(DestinationRow) Then Set DestinationRow = Nothing
End Sub
I am getting a Run-time error'438'
"Object doesn't support this property or method" on "SelectCell.EntireRow.Select"
Well your code has a typo
SelectCell.EntrieRow.Select
should say entire not Entrie. Personally I would use this method anyway, It selects the entire row based on the number you put in. FYI there is also a corresponding Columns().select if you need it in the future
sel_cell_row = SelectCell.Row
Rows(sel_cell_row).select
edit addressed to comment
The reason you get the 1004 error is like it says, the copy and paste areas don't match. Think of copying 10 rows, and trying to paste it into 2 rows, simply wouldn'y work. I'm guessing the problem actually stems from your destinationrows code. I'm not entirely sure what its trying to do, but here are two generic fixes
1)keep the copy code as it is, and modify the paste. Instead of selecting a range of cells to paste into, select the first cell (if your range was a1:a10, selecting a1 is sufficient) excel will then paste all the data starting at that first cell. so in your code do this
'comment out all this destination row stuff
'Set DestinationRow = DestinationSheet.Range("L1:L" & DestinationSheet.Cells(Rows.Count, "L").End(xlUp).Row)
'Range("L" & DestinationRow.Rows.Count + 1).Select
Range("L1").select 'only referencing the first cell to paste into
ActiveSheet.Paste
2)rather than selecting an entire row, why not select only the populated values in that row something like
sel_cell_row = SelectCell.Row
lastColumn = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column
range(Cells(sel_cell_row ,1),Cells(sel_cell_row ,lastColumn )).select
then do your copy as usual. the 1 is for column 1, or A. I'm assuming the data you want is in one row starting at column A and going till lastColumn. Maybe now this will match your destinationrows code.
3)Com,bine options 1 and 2. so copy only the populated cells, and paste to the first cell in the range
Iam a DB Guy and i dont know anything about VB.
I have a Macro in Excel and in Excel i have cross tabular records.
My macro will convert Crosstabular records to tabular records.
But My requirement is i want to Run the Same Macro outside the excel.
.VBS file should be there and whenever we run the .VBS it should pick excel from some place and convert the crosstab records to tabular records and save at some different location.
I have created a Code for the same by googling and Somebody Please review my below code and help me with the Proper code.
Sub RunMacro()
Dim xlApp 'As Excel.Application
Dim xlBook 'As Workbook
Dim xlSheet 'As Worksheet
Dim wsCrossTab 'As Worksheet
Dim wsList 'As Worksheet
Dim iLastCol 'As Long
Dim iLastRow 'As Long
Dim iLastRowList 'As Long
Dim rngCTab 'As Range 'Used for range in Sheet1 cross tab sheet
Dim rngList 'As Range 'Destination range for the list
Dim I 'As Long
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open("D:\Source.xls")
CrossTabToList()
xlBook.SaveAs "D:\Results.xls"
xlApp.Quit
End Sub
Sub CrossTabToList()
Set wsCrossTab = Worksheets("Tabular")
Set wsList = Worksheets.Add
'Find the last row in Sheet1 with the cross tab
iLastRow = wsCrossTab.Cells(Rows.Count, "A").End(xlUp).Row
'Set the initial value for the row in the destination worksheet
iLastRowList = 2
'Find the last column in Sheet1 with the cross tab
iLastCol = wsCrossTab.Range("A8").End(xlToRight).Column
'Create a new sheet and set the heading titles
wsList.Range("A1:C1") = Array("CATEGORY", "SUBCATEGORY", "VALUE")
'Start looping through the cross tab data
For I = 2 To iLastRow
Set rngCTab = wsCrossTab.Range("A" & I) 'initial value A2
Set rngList = wsList.Range("A" & iLastRowList) 'initial value A2
'Copy individual names in Col A (A2 initially) into as many rows as there are data columns in the cross tab (less 1 for Col A).
rngCTab.Copy rngList.Resize(iLastCol - 1)
'Move up a I rows less one and across one column (using offset function) to select heading row. Copy.
rngCTab.Offset(-(I - 1), 1).Resize(, iLastCol - 1).Copy
'Paste transpose to columns in the list sheet alongside the names
rngList.Offset(0,1).PasteSpecial Transpose:=True
'Staying on same row (2 initially) copy the data from the cross tab
rngCTab.Offset(, 1).Resize(, iLastCol - 1).Copy
'Past transpose as column in list sheet
rngList.Offset(0, 2).PasteSpecial Transpose:=True
'Set the new last row in list sheet to be just below the last name copied
iLastRowList = iLastRowList + (iLastCol - 1)
'increment I by 1
Next I
Application.DisplayAlerts = False
Sheets("Tabular").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Results"
objwkbk.SaveAs "D:\Results.xls"
End Sub
Thanks,
Praveen
As i mentioned i am not a Java Developer or Coding guy,i am a Database person ,i dont know anything about Java .I want to use the above code as .VBS file.I want somebody to correct my above code to use it in a .VBS File.If you can do that it will be really appreciated.
Thanks in Advance.
That's a very good idea. VBA in an Excel file can confuse users, so I try to avoid that whenever possible.
I recommend storing your procedure in an Access file. There's a little work involved in converting it, but this should get you started:
Make a new Access db
In your new db, make a new VBA module. Paste your code in there.
Add your most current version of Microsoft Excel Object Library.
Make whatever other changes are necessary to get the code in working order again (you'll have to do a bit of trial and error. Run the code repeatedly and deal with the error messages as they pop up)
Change your Sub to a Function (you need to do this to call it from a Macro)
Make a new Macro. Add the action RunCode with the argument RunMacro()
In the future, all you will have to do is open the db and click on the macro to run the code.
I'm tyring to look for a way to return a range of cells with just the lookup function. Is this really possible?
Basically like this:
=LOOKUP([MasterBook.xlsm]Sheet3!$A:$A,?)
I just want the function to look in the main workbook through all of Column A and return all cells for Column A that have something in them.
EDIT for poster below:
Sure. I have two workbooks; one workbook is essentially a local product that has a "master" sheet on top and then individual worksheets following it that have all of their information extracted from the master sheet. The second workbook is a local copy of a product that I send to a non-local entity higher up the food chain. Basically I need to pull information from the individual sheets in my first workbook and put it in the appropriate columns in the second workbook. I have a macro that gets the info from my sheets in the one workbook over to the other, but the second workbook is formatted differently. I was looking for a way to use a formula if possible.
The macro I am referring to is:
Sub CopyTest()
Dim sourceColumn As Range, targetColumn As Range
Set sourceColumn = Workbooks("Local Workbook.xlsm").Worksheets("Sheet3").Columns("A")
Set targetColumn = Workbooks("Nonlocal Workbook.xlsm").Worksheets("Sheet1").Columns("A")
sourceColumn.Copy Destination:=targetColumn
End Sub
All this does is pull the specified column from one sheet and put it in the column on the second book; but it just pastes it starting in the first block. Since the non-local book is formatted differently, the column I need to transfer to doesn't start until Row 9. shrug I have ideas abuot what I'm trying to do with this, but my ideas tend to exceed my technical ability (which occasionally makes it difficult to explain). :)
Depending on how different your workbooks are formatted. Here is two way to handle this:
Adapt your macro
Instead of copying the whole column, you can copy paste, only the values you want to.
Here is an example:
Sub CopyTest()
Dim rSource As Range, rTarget As Range
Dim lEnd As Long
lEnd = Range("A65536").End(xlUp).Row
Set rSource = Workbooks("Local Workbook.xlsm").Worksheets("Sheet3").Range("A1:A" & lEnd)
Set rTarget = Workbooks("Nonlocal Workbook.xlsm").Worksheets("Sheet1").Range("A9")
rSource.Copy Destination:=rTarget
End Sub
Use a formula
If your data are not in the same order, you'd better use a VLOOKUP formula.
See how it works.
Don't hesitate to post another question with what you've built for some help. Please give as much details as possible so we could help you the best way.
[EDIT] Another try following the comments
Option Explicit
Dim wTarget As Workbook
Sub mainCopy()
Dim bGo As Boolean
bGo = True
'Add a new workbook to copy the data - do you want the user to select one?
Set wTarget = Application.Workbooks.Add()
Do While bGo
CopyTest
bGo = MsgBox("Do you want to import data from another workbook?", vbYesNo, "Continue?")
Loop
End Sub
Sub CopyTest()
Dim rSource As Range, rTarget As Range
Dim lEnd As Long, lCol As Long
Dim ws As Worksheet
Dim vFile As Variant
vFile = Application.GetOpenFilename("Excel-files,*.xls", _
1, "Select One File To Open", , False)
'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile
For Each ws In ActiveWorkbook.Worksheets
'do you need to copy the columns separately?
' For lCol = 1 To 10
'find the last cell of the 10th column
lEnd = ws.Cells(65536, 10).End(xlUp).Row
Set rSource = ws.Range("A1:J" & lEnd)
'How can we define the target worksheet?
Set rTarget = wTarget.Worksheets("Sheet1").Range("A9")
rSource.Copy Destination:=rTarget
' Next lCol
Next ws
End Sub