copy and pasting data from one workbook into another - excel

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

Related

Referring to a new workbook in Excel VBA

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.

Code doesn't work when referencing to another workbook

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.

How to Copy/Paste to next empty row?

I have code to copy a Worksheet A, columns A:C (no set row quantities, this will be re-used and the quantities will change) and paste to the first blank row in the same workbook, different sheet, Worksheet B (this also has no set row quantities and will change).
Worksheet B has a formula in the same columns that I want to paste to that returns "" if there is no data. I think VBA is seeing the "" and assuming there is data there; however, it is not pasting even to lines without said formula.
Sub Copy_Created_Fringe_Accounts()
Dim SourceRange As Range
Dim DestRange As Range
Dim DestSheet As Worksheet
Dim LastRow As Long
'Source sheet and range
Set SourceRange = Sheets("CREATED FRINGE ACCTS").Range("A2:C500")
'Destination sheet and range
Set DestSheet = Sheets("99 BUDGET WORKSHEET")
'Last Row
LastRow = DestSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'Copy and paste to destination
Set DestRange = DestSheet.Range("A" & LastRow + 1)
SourceRange.Copy DestRange
End Sub
Nothing happens when I run it. I expect to see the data from Worksheet A copied to Worksheet B, starting at the first available empty row.
I am fairly new to VBA so any help/understanding is appreciated.
Finding the last row
Try using UsedRange to find the last used row as this is safer than using Find.
LastRow = DestSheet.UsedRange.Rows.Count
A side note
If your code resides in the same place as these worksheets then I would recommend using their code name. This will protect you from running into an error if the sheet doesn't exist.

How to copy data from one worksheet to another to a specific row

To all,
thanks for your time in advance.
we already have working code to move data from one wrksht to another with vb in excel.
we use:
Set lastrow = Sheets ("SR log").Cells(Rows.Count, 1).End(x1UP)
With LastRow
This places our selected data on the last open row of sheet 2
Is it possible to , instead of the last row, Search for a reference number from the first sheet that is already on the second sheet , lets say Cell G3. use the information from the first sheet in cell g3 and look for it on the second sheet.
Once that row is found ( the G3 data from the first sheet will be in column A of the second sheet)
Now apply data to that row where applicable.
any help would be appreciated.
2/22/19
Here is my response.
thankyou for taking the time
I have put something together but wanted to run it by before executing
[code]
Private Sub CommandButton2_Click()
Workbooks.Open Filename:="G:\General\COVER SHEET_Protective\Protective Packaging Order Log.xlsm", Password:="PP", WriteResPassword:="PP"
Dim FoundRow As Variant
FoundRow = Application.Match(Sheets(1).Range("G3"), Sheets(2).Columns(1), 0)
If IsNumeric(FoundRow) Then
With FoundRow
' found, use FoundRow like LastRow before
End With
Else
' not found :(
End If
.Offset(1).Font.Size = 14
.Offset(1, 9) = ws.[I10]
.Offset(1, 10) = ws.[I11]
End Sub
[/code]
I'm am a little unsure about this row
[code]
Application.Match(Sheets(1).Range("G3"), Sheets(2).Columns(1), 0)
[/code]
the match sheets 1 on the first workbook is called worksheet
and on the second workbook where the search is happening on the first
column
the sheet is called orderlog
thanks
You can find the matching row with Application.Match:
Private Sub CommandButton2_Click()
Dim wb1 As Workbook ' first workbook
Dim wb2 As Workbook ' second workbook
Dim wsCheck As Worksheet ' sheet in the first workbook
Dim wsOrderlog As Worksheet ' sheet in the second workbook
' address the first workbook and its sheet
' if this VBA-code is in the frist workbook, it's "ThisWorkbook"
Set wb1 = ThisWorkbook
Set wsCheck = wb1.Worksheets("Worksheet")
' check, if second workbook is already open
For Each wb2 In Workbooks
If wb2.Name = "Protective Packaging Order Log.xlsm" Then Exit For
Next wb2
' if not already open, then open it, and address its sheet also
If wb2 Is Nothing Then
Set wb2 = Workbooks.Open( _
Filename:="G:\General\COVERSHEET_Protective\Protective Packaging Order Log.xlsm", _
Password:="PP", _
WriteResPassword:="PP")
End If
Set wsOrderlog = wb2.Worksheets("orderlog")
' search a value from the first workbook's sheet within second workbook's sheet
Dim FoundRow As Variant
FoundRow = Application.Match(wsCheck.Range("G3").Value, wsOrderlog.Range("A:A"), 0)
If IsNumeric(FoundRow) Then ' if found
' please adapt to your needs:
wsOrderlog.Cells(FoundRow, 1).Font.Size = 14
wsOrderlog.Cells(FoundRow, 9).Value = wsCheck.Range("I10").Value
wsOrderlog.Cells(FoundRow, 10).Value = wsCheck.Range("I11").Value
Else
MsgBox "Sorry, the value in cell G3" & vbLf & _
wsCheck.Range("G3").Value & vbLf & _
"could not be found in orderlog column A."
End If
' close the second workbook (Excel will ask, if to save)
wb2.Close
End Sub

Setting value using filtered data

I'm trying to open a sheet (Archive) from my inventory sheet, filter the data in the second sheet and then copy the filtered data to a sheet on the inventory. Everything is working except that the filtered data only copies the data from rows in the first contiguous range. My code is as follows
Dim LastRow As Long
Dim nOoFrOWS As Long
Dim oSht As Worksheet
Workbooks.Open ("C:\Inventory\Archive.xlsm") '<- at opening a workbook it becomes the active one
Set oSht = ActiveWorkbook.Worksheets("Archive") '<-- set the destination worksheet in the activeworkbook
With ActiveSheet
.ListObjects("Archive").Range.AutoFilter Field:=12, Criteria1:=mOrder
nOoFrOWS = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1 '# of rows in Inventory
End With
Unload Me
ThisWorkbook.Sheets("RAM").Range("A2:K" & nOoFrOWS).Value = oSht.Range("Archive[[QTY]:[RTK]]").SpecialCells(xlCellTypeVisible).Cells.Value
oSht.Parent.Close False
What am I doing wrong?
edit: I don't know if it is pertinent, but the range in the archive (from which I am copying) is not the entire table. I have more rows, but These are all I need for this application.
Also, is there a way to do this without the clipboard by using .value or am I stuck with using the copy paste method?
As your working with a table you can copy the visible cells in the databodyrange.
No need to activate or select anything - just work with the referenced files & sheets.
Sub Test()
Dim wrkBk As Workbook
Dim mOrder As Long
mOrder = 5
'You can reference the workbook without it being active.
Set wrkBk = Workbooks.Open("C:\Inventory\Archive.xlsm")
With wrkBk.Worksheets("Archive").ListObjects("Archive")
.Range.AutoFilter Field:=12, Criteria1:=mOrder
'Copy the DataBodyRange (Range would include the headers).
.DataBodyRange.Resize(, 11).SpecialCells(xlVisible).Copy Destination:=ThisWorkbook.Worksheets("RAM").Range("A2")
End With
End Sub

Resources