Referring to a new workbook in Excel VBA - excel

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.

Related

Save a cell area in another sheet

I have an excel workbook that allows me to calculate values in a sheet called "Calc_tool". Now I need to use it for several soils and I would like to have a button at the end of my table that:
creates a new sheet (in the same workbook)
copy the data from my first sheet and paste in the new sheet (keeping the column width)
clear the initial table so that I can enter the data of the next soil
[Edit] Thanks to the community, here is the code that does it:
Sub Clearcells()
Dim sheet As Worksheet
Set sheet = ThisWorkbook.Sheets.Add _
(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
ThisWorkbook.Sheets("Calc_tool").Range("B3:I59").Copy
With Range("B2")
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteValues, , False, False
.PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
End With
ThisWorkbook.Sheets("Calc_tool").Range("D3:D54").ClearContents
Call ThisWorkbook.Sheets("Calc_tool").Activate
End Sub
Hope this will help others!
This code does what you want:
Sub CommandButton1_Click()
Dim sheet As Worksheet
Set sheet = ThisWorkbook.Sheets.Add _
(After:=ThisWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
ActiveWorkbook.Sheets("Hoja1").Range("A5:A12").Copy
Destination:=sheet.Range("E5")
Dim colWidth As Long
colWidth = ThisWorkbook.Sheets("Hoja1").Range("A5:A12").ColumnWidth
sheet.Range("E5").ColumnWidth = colWidth
End Sub
Sheet1 is where the range you want to copy is. E5 is the range where you want to paste your cells in the created worksheet.
Hope that helps!
Command to create a new sheet is
Sheets.Add
There are thousands of commands to copy content, one is
Range(TargetRange).value = Range(InputRange).value
If the ranges are at different sheets, add sheets("sheetname"). in front of each range or set variables as worksheets.
One command for your last requirement is in your question already.
Total code could look like this:
Sub Button1_Click()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim oRange As String
Dim tRange As String
Set sh1 = Sheets("Sheet1") '<- replace Sheet 1 with your input sheet's name
oRange = "D5:E31" '<- Input Range in sheet 1
tRange = "D5:E31" '<- Target Range in sheet 2
Sheets.Add
Set sh2 = ActiveSheet
sh2.Range(tRange).Value = sh1.Range(oRange).Value
sh1.Range(oRange).ClearContents
End Sub

How to copy values and formatting when copy entire sheet with VBA

I have the code below that works really well.
It copies the active worksheet and creates a new sheet with name based on a specific cell.
Can I modify this to not include formulas when copied? I only want Values and Formatting, so the new sheet is a static snapshot.
Sub Copyrenameworksheet()
Dim ws As Worksheet
Set wh = Worksheets(ActiveSheet.Name)
ActiveSheet.Copy After:=Worksheets(ActiveSheet.Name)
If wh.Range("C2").Value <> "" Then
ActiveSheet.Name = wh.Range("C2").Value
End If
wh.Activate
End Sub
How about the following as a general method to make a static copy of a worksheet:
Dim sht1 As Worksheet 'worksheet to copy from
Dim sht2 As Worksheet 'worksheet to paste to
Set sht1 = ThisWorkbook.Worksheets("Name of the Worksheet to copy from")
sht1.Cells.Copy 'Copy everything in the worksheet
Set sht2 = ThisWorkbook.Worksheets.Add 'create new blank worksheet
sht2.Cells.PasteSpecial xlPasteValues 'first paste values
sht2.Cells.PasteSpecial xlPasteFormats ' then paste formats
sht2.Name="Something" 'give a name to your new worksheet
Also please avoid using ActiveSheet and use explicit references to your worksheets instead.
I modified your code slightly to use variables for your original sheet and your copied sheet. I use .Value2 = .Value2 to remove formulas. Note that this will run into an error if you try to create multiple sheets using the same name in C2.
Sub Copyrenameworksheet()
Dim wsOrig As Worksheet, wsNew As Worksheet
Set wsOrig = Worksheets(ActiveSheet.Name)
wsOrig.Copy , wsOrig
Set wsNew = Worksheets(wsOrig.Index + 1)
If wsOrig.Range("C2").Value <> "" Then
wsNew.Name = wsOrig.Range("C2").Value
End If
wsNew.UsedRange.Value2 = wsNew.UsedRange.Value2
wsOrig.Activate
End Sub

Keep the reference in the formula when cells are copied to another sheet

I have code below that is working perfectly - But only one thing is missing.
In the sheet "Opgørsel" i have a database, where the formulas drag it in and calculate - When i then let the macro run, it can´t find the database - My quetions is so, how can let the formulas find the database in sheet "Opgørsel" when they are copied over? what should i change or modify?
Sub Copypastemeddata()
Dim wb As Workbook
Dim ws As Worksheet
Dim sourceCell As Range
Dim targetSheet As Worksheet
Dim StartRow As Integer
Application.ScreenUpdating = False
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Opgørsel")
Set sourceCell = ws.Range("D3") 'Cell with sheet names for copying to
StartRow = 1 'Destination row on targetSheet
With ws
Set targetSheet = wb.Worksheets(sourceCell.Text)
.Range("A1").CurrentRegion.Copy
targetSheet.Range("A" & StartRow).Insert shift:=xlDown
targetSheet.Columns.AutoFit
End With
Application.CutCopyMode = 0
Application.ScreenUpdating = True
End Sub
This is my formula: HVIS=IF function - It wont do it.
=HVIS(B7=$A$34;"";HVIS(B7=$A$33;"";HVIS(B7=$A$35;2*3,14*F7*I7;HVIS(B7=$A$36;
3,14*F7*I7;HVIS(B7=$A$37;SUM(C7:F7)*I7;HVIS(B7=$A$38;(C7+D7)*2*I7;HVIS(B7=$A$39;
C7*I7;HVIS(B7=$A$40;I7*C7;HVIS(B7=$A$41;SUM(C7:E7)*I7;HVIS(B7=$A$42;(C7+D7)*I7))))))))))"
Why not in your source sheet, qualify all the ranges in the formulas with the source sheet reference? That way the sheet reference will also be copied over to the new sheet along with the formulas. e.g. on the sheet opgørsel, if there is a formula say =A2, change it to =opgørsel!A2 so that when the formula cell is copied over to another sheet it will copy the formula as well as the sheet reference. Is that what you are trying to achieve?
Please remember that you just don't need to prefix your formula with the sheet reference but you should qualify all the ranges used in the formula with the sheet reference.

copy and pasting data from one workbook into another

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

Combine worksheets and add column in Excel

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

Resources