VBA Copying Excel Range to Different Workbook - excel

I am trying to find a way to copy a range in one workbook, in this case A6:J21,to another workbook. I thought it would be something like the following...
currentWorksheet = xlWorkBook.Sheets.Item("Command Group")
excelRange = currentWorksheet.Range("A6:J21")
excelDestination = newXlSheet.Range("A6:J21")
excelRange.Copy(excelDestination)
But it gives me an error on excelRange.Copy(excelDestination).
The below code runs as expected, so I'm not sure where i'm going wrong here..
Dim xRng As Excel.Range = CType(currentWorksheet.Cells(7, 7), Excel.Range)
Console.WriteLine(xRng.ToString)
Dim val As Object = xRng.Value()
testString = val.ToString
Console.WriteLine(testString)
newXlSheet.Cells(1, 1) = testString

To answer your question "Why is B running, but not A"..
In A:
currentWorksheet = xlWorkBook.Sheets.Item("Command Group")
First, you are missing SET for your object assignment. Secondly, you are using Workbook.Sheets.Item() which returns a Sheets object. A Sheets object can represent either a chart sheet, or a work sheet, and therefore does not have a .Range() method.
You can verify this by stepping over this code:
Dim currentWorksheet As Sheets
Set currentWorksheet = ThisWorkbook.Sheets.Item("Command Group")
excelRange = currentWorksheet.Range("A1:A21")
It will error, and tell you that the method is not found.
To Fix A: Ensure you get back a Worksheet object by using strong typing.
Dim currentWorksheet as Worksheet
Set currentWorksheet = ThisWorkbook.Sheets.Item("Command Group")
To fix future code and ease the debugging process I highly recommend always declaring Option Explicit at the top of all your modules.
For brevity you can shorten your code to:
Dim currentWorksheet as Worksheet
Set currentWorksheet = ThisWorkbook.Sheets("Command Group")

This should do it, let me know if you have trouble with it:
Sub foo()
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, copy what you want from x:
x.Sheets("name of copying sheet").Range("A1").Copy
'Now, paste to y worksheet:
y.Sheets("sheetname").Range("A1").PasteSpecial
'Close x:
x.Close
End Sub
Alternatively, you could just:
Sub foo2()
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
Copy from one workbook and paste into another

Refer to the below code to copy data from one worksheet(say file1) to the other(say file2). I created this file to avoid copying formats from the other workbook as it was causing the file(say file1) to crash. The intention is to copy only values cell by cell from one sheet to another sheet.
Sub Copydatafrom_sheets()
'This will copy sheet cell by cell without selecting the cells.
'commented items are not used in the code execution
Dim i As Long
Dim j As Long
i = 1
j = 1
Application.ScreenUpdating = False
Dim file1 As Workbook ' defined as workbook
Dim file2 As Workbook ' defined as workbook
Dim range1 As Range
Dim range2 As Range ' not used
Dim Copied_data As String ' to store data in this string while iterating
Set file1 = Workbooks.Open("G:\MyProject - Backup\QAQC\Data Combined - 2.xlsx") ' file where orinal data is stored, use your own file names
Set file2 = Workbooks.Open("G:\MyProject - Backup\QAQC\Test3.xlsm") ' File where it shall be copied
Set range1 = file1.Sheets("ASC_Table_1").Range("A1:V25944") 'set the range to be copied
For Each cell In range1
Copied_data = file1.Sheets("ASC_Table_1").Cells(i, j).Value
'MsgBox (Copied_data)
file2.Sheets("Sheet2").Cells(i, j) = Copied_data
If j <= 22 Then j = j + 1
If j > 22 Then
i = i + 1
j = 1
End If
Application.StatusBar = Format((i / 25994), "Percent")
Next
Application.ScreenUpdating = True
file2.Save 'Optional
End Sub

Related

Loop instruction through list of known paths

I have a list of files with the same structure and I want to extract some information from columns A, B, and C and print it to another workbook.
I found a way to do it for a single file, but now I don't understand how can I do it using the list of given files. I tried using collections, but it doesn't work.
Here's what I came up with:
Sub Pulsante1_Click()
Dim FileGeStar As Variant
Dim myCol As Collection
Set myCol = New Collection
myCol.Add "C:\Users\xxx\Desktop\articoli_def.xlsx"
myCol.Add "C:\Users\xxx\Desktop\pippo\SS20_def_ENG.xlsx"
For Each FileGeStar In myCol
Workbooks.Open Filename:=FileGeStar
FileGeStar = Application.ActiveWorkbook.Name
Dim Code As String
Dim Description As String
Dim FilePath As String
Dim i As Long
i = 2
While Range("A" & i) <> ""
FilePath = Application.ActiveWorkbook.Path
Code = Trim(Range("A" & i).Value)
Description = Trim(Range("B" & i).Value)
Workbooks("Report.xlsm").Worksheets(1).Range("A" & i).Value = FilePath
Workbooks("Report.xlsm").Worksheets(1).Range("B" & i).Value = Code
Workbooks("Report.xlsm").Worksheets(1).Range("C" & i).Value = Description
i = i + 1
Wend
Next FileGeStar
End Sub
What can I do?
This might look like an overkill, but I hope the code and comment's are self explanatory:
Option Explicit
Sub Pulsante1_Click()
Dim DestinationWorkbook As Workbook
Set DestinationWorkbook = ThisWorkbook 'I think report.xlsm is the workbook running the code
'if report.xlsm is not the workbook running the code then change thisworkbook for workbooks("Report.xlsm")
'add as many paths as you need to, another way would be to write them in a sheet and loop through to fill the array
Dim MyPaths As Variant
MyPaths = Array("C:\Users\xxx\Desktop\articoli_def.xlsx", "C:\Users\xxx\Desktop\pippo\SS20_def_ENG.xlsx")
'Declare a workbook variable for the source workbooks
Dim SourceWorkbook As Workbook
'Declare a long variable to loop through your path's array
Dim i As Long
'loop through the start to the end of your array (will increase as the array does)
For i = LBound(MyPaths) To UBound(MyPaths)
Set SourceWorkbook = OpenWorkbook(MyPaths(i)) 'this will set the workbook variable and open it
CopyData SourceWorkbook, DestinationWorkbook 'this will copy the data to your destination workbook
SourceWorkbook.Close , False
Set SourceWorkbook = Nothing
Next i
End Sub
Private Function OpenWorkbook(FullPath As String) As Workbook
Set OpenWorkbook = Workbooks.Open(FullPath, False, True)
End Function
Private Sub CopyData(wbO As Workbook, wbD As Workbook)
'this procedure calculates the last row of your source workbook and loops through all it's data
'later calls the AddDataToMasterWorkbook procedure to paste the data
With wbO.Sheets(1) 'Im assuming your source workbook has the data on sheet1
Dim LastRow As Long
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Dim FilePath As String
FilePath = wbO.Path
Dim Code As String
Dim Description As String
Dim C As Range
For Each C In .Range("A2:A" & LastRow) 'this will loop from A2 to the last row with data
Code = Trim(C)
Description = Trim(C.Offset(, 1))
AddDataToMasterWorkbook wbD, FilePath, Code, Description
Next C
End With
End Sub
Private Sub AddDataToMasterWorkbook(wb As Workbook, FilePath As String, Code As String, Description As String)
'This procedure calculates the last row without data and adds the items you need every time
With wb.Sheets(1)
Dim LastRow As Long
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
.Range("A" & LastRow) = FilePath
.Range("B" & LastRow) = Code
.Range("C" & LastRow) = Description
End With
End Sub
To loop though files, you can indeed use a collection, or an array, you can also loop through all files in directory with certain extension, or partial file name. Check out DIR function.
Best not to use ActiveWorkbook, better approach would be to set a workbook object like so: Set wb = Workbooks.Open(fullPathToYourWorkbook).
For what you're doing, there's no need to go row by row, much more efficient way would be to copy entire range, not only it's a lot quicker but also it's only 1 line of code; assuming your destination is ThisWorkbook.Sheets(1) and wb object is set: wb.Range("A:C").Copy Destination:=Thisworkbook.Sheets(1).Range("A:C"). If you need to edit copied data (trim or whatever) consider Range Replace method.
However, if you want to go row by row for whatever reason, as BigBen mentioned in the comment - get rid of While loop.
It's a good idea to set Application.ScreenUpdating to False when opening/closing workbooks, then back to True once it's all done. It will prevent user from accidentaly clicking something etc and will make it look like it's not opening any workbook.
Here's my approach (untested) assuming the workbook you want to copy data to is Workbooks("Report.xlsm").Worksheets(1):
Sub Pulsante1_Click()
'set workbook object for the destination workbook
set wb_dest = Workbooks("Report.xlsm").Worksheets(1)
'disable screen updating
Application.ScreenUpdating = False
For Each target_wb In Array("C:\Users\xxx\Desktop\articoli_def.xlsx", "C:\Users\xxx\Desktop\pippo\SS20_def_ENG.xlsx")
'set wb object and open workbook
Set wb = Workbooks.Open(target_wb)
'find last row in this workbooks in columns A:B (whichever is greater)
LastRow = wb.Range("A:B").Find(What:="*", After:=wb.Range("A1"), SearchDirection:=xlPrevious).row
'copy required data
wb.Range("A1:B" & LastRow).Copy Destination:=wb_dest.Range("B1:C" & LastRow)
'fill column A with path to the file
wb_dest.Range("A1:A" & LastRow).Value = wb.Path
'close workbook
wb.Close False
Next
'enable screen updating
Application.ScreenUpdating = True
End Sub
Obviously an array is not the best approach if you have loads of different files, collection would be a lot clearer to read and edit in the future, unless you want to create a dynamic array, but there's no need for that in my opinion. I didn't declare variables or write any error handling, it's a simple code just to point you in the right direction.
If you want to disable workbook events or/and alerts, you can set Application.DisplayAlerts and Application.EnableEvents to False temporarily.

How to name a worksheet?

I have a file (F) that contains several workbooks, each workbook has the same format. I do a conditional sum on each of the workbook under column conditions. I want to put the output within another workbook that contains one worksheet per workbook looped (contained within F).
I cannot find the good strategy to change the worksheet name in function of the looped workbook' name.
Set Output_tot_n = Workbooks("Final_Output").Sheet_name.Range("B7")
I got
Error 438 "Object doesn't support this property or method"
The whole code:
Sub Proceed_Data()
Dim FileSystemObj As Object
Dim FolderObj As Object
Dim fileobj As Object
Dim Sheet_name As Worksheet
Dim i, j, k As Integer
Dim wb As Workbook
Set FileSystemObj = CreateObject("Scripting.FileSystemObject")
Set FolderObj = FileSystemObj.GetFolder("C:\...\")
For Each fileobj In FolderObj.Files
Set wb = Workbooks.Open(fileobj.Path)
Set Output_tot_n = Workbooks("Final_Output").Sheet_name.Range("B7")
If wb.Name = "AAA_SEPT_2018" Then
Sheet_name = Worksheets("AAA")
End If
If wb.Name = "BBB_SEPT_2018" Then
Sheet_name = Worksheets("BBB")
End If
If wb.Name = "CCC_SEPT_2018" Then
Sheet_name = Worksheets("CCC")
End If
' conditional sum
With wb.Sheets("REPORT")
For i = 2 To .Cells(Rows.Count, 14).End(xlUp).Row
If .Cells(i, "O").Value = "sept" Then
k = .Cells(i, "M").Value
End If
j = j + k
k = 0
Next i
End With
Output_tot_n = j
j = 0
wb.Save
wb.Close
Next fileobj
End Sub
Workbooks is a collection (part of the actual Application-object). A collection in VBA can be accessed either by index number (index starts at 1) or by name. The name of an open Workbook is the name including the extension, in your case probably either Final_Output.xlsx or Final_Output.xlsm.
Sheets and Worksheets are collections within a Workbook, again accessed via index or name (the difference is that Worksheets contains "real" spreadsheets while Sheets may also contain other sheet types, eg charts).
So in your case, you want to access a Range of a specific sheet of a specific workbook. The workbook has a fixed name, while the sheet name is stored in a variable. You can write for example
dim sheetName as string, sheet as Worksheet, Output_tot_n as Range
sheetName = "AAA" ' (put your logic here)
set sheet = Workbooks("Final_Output.xlsm").Worksheets(Sheet_name)
set Output_tot_n = sheet.Range("B7")
or put all together (depending on your needs)
set Output_tot_n = Workbooks("Final_Output.xlsm").Worksheets(Sheet_name).Range("B7")
No it actually works. Thank you again for your answers.
the problem was just is important to put "AAA_SEPT_2018.xlsx"

VBA Deleting rows by found cell values

I have this code and i want to delete all rows by cell value which contain "BSB*" (so there are values like BSB 1, 2 etc) this code works partially. It deletes only every second cell which contain BSB. So i have BSB 2, 4 etc. I want to delete all rows where value BSB is present in speecific column ofc.
p.s english is my second language so please let mi know if i need to clarify something
Option Explicit
Sub PrList()
Dim wb As Workbook
Dim ws As Worksheet
Dim r As Range
Dim i As Range
Set wb = Workbooks.Open("?????")
Set ws = wb.Worksheets("owssvr")
With ws.Range("A1").CurrentRegion
.Find(What:="Product_Number", LookAt:=xlWhole).Name = "Product_Number"
.Find(What:="Product_Status", LookAt:=xlWhole).Name = "Product_Status"
.Find(What:="Group_of_product", LookAt:=xlWhole).Name = "Group_of_product"
End With
Set i = ws.Range("Product_Number", Range("Product_Number").End(xlDown))
For Each r In i
If r Like "BSB*" Then
r.Rows.Delete
End If
Next r
End Sub
Try this
Option Explicit
Sub NAPP_PrList()
Dim wb As Workbook
Dim ws As Worksheet
Dim r As Range
Dim i As Range
Dim j as Long
Set wb = Workbooks.Open("?????")
Set ws = wb.Worksheets("owssvr")
With ws.Range("A1").CurrentRegion
.Find(What:="Product_Number", LookAt:=xlWhole).Name = "Product_Number"
.Find(What:="Product_Status", LookAt:=xlWhole).Name = "Product_Status"
.Find(What:="Group_of_product", LookAt:=xlWhole).Name = "Group_of_product"
End With
Set i = ws.Range("Product_Number", Range("Product_Number").End(xlDown))
For j = i.Rows.Count To 1 Step -1
If i(j, 1) Like "BSB*" Then i(j, 1).EntireRow.Delete
Next
End Sub

VBA-Excel 2010 Macro Error "memeber or data method not found"

I know this is a super generic error but I am new to VBA / Macros and cant get past this.
I have an and excel workbook that has data I need to copy to another excel workbook.
The excel workbook that the data is copied to is on a network share and will be written to frequently.
here is my macro code:
Sub export()
Dim exportFile As String
Dim importSheet As String
Dim rowData As String
exportFile = "\\<server>\spd\_Spec_ParaData\data_import.xlsx"
importSheet = "OutPutValues"
importRange = "A2:ZZ2"
' Get the row from the workbook that we are running in
rowData = Workbooks().Worksheets(importSheet).Range(importRange)
' Not sure if this will work, or always overwrite the last row. May need to be .Row+1
newRow = Workbooks(exportFile).Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row
exportRange = "A" & (newRow + 1) & ":ZZ" & (newRow + 1)
' Assuming Workbooks() gets the current workbook.
Workbooks(exportFile).Sheets(exportSheet).Range(exportRange) = Workbooks().Sheets(importSheet).Range(importRange)
End Sub
My error is poping up on the rowData=Workbooks(exportFile).Worksheets
Can someone help me figure out what I am doing wrong?
Thank you,
Jennifer
Try your code with the following modifications, I'm just opening the workbook and referencing the worksheet (I guess the problem is that). I'm closing the workbook straight after.
Sub export()
Dim exportFile As String
Dim importSheet As String
Dim rowData As String
Dim wb As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
exportFile = "\\<server>\spd\_Spec_ParaData\data_import.xlsx"
importSheet = "OutPutValues"
importRange = "A2:ZZ2"
'Open your workbook and point to your spreadsheet
Set wb = Workbooks.Open(exportFile)
Set ws1 = wb.Sheets(importSheet)
' Get the row from the workbook that we are running in
rowData = wb.ws.Range(importRange)
' Not sure if this will work, or always overwrite the last row. May need to be .Row+1
newRow = wb.Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row
exportRange = "A" & (newRow + 1) & ":ZZ" & (newRow + 1)
'NOTE: consider definying the variable "exportSheet", I will do it just for example purpose
Dim exportSheet As String: exportSheet = "InputValues"
Set ws2 = wb.Sheets(exportSheet)
' Assuming Workbooks() gets the current workbook.
wb.ws2.Range(exportRange) = wb.ws1.Range(importRange)
wb.Close
End Sub

Copying specific columns from several workbooks to one master workbook, without constantly editing code

I am trying to read a specific set of columns from a workbook (every week it is a new workbook) and copy them into another workbook. This I have been able to do, but I think there is a cleaner way to do it!! My code is very bulky and problematic, as every week I need to read info from a different workbook so I have to go back into the code and change the workbook file name. I would love any input on how to improve the code and speed up changing the file name for the workbook from which columns are copied....for example is it possible to ask the user to input the file name in place of a static name??
Any feedback / suggestions are greatly appreciated!!! My code is below:
Sub CopyColumnToWorkbook()
Dim sourceColumns As Range, targetColumns As Range
Dim qw As Range, rw As Range
Dim sd As Range, fd As Range
Dim bu As Range, hu As Range
Dim zx As Range, gx As Range
Dim op As Range, wp As Range
Dim ty As Range, ly As Range
Set sourceColumns = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("L")
Set targetColumns = Workbooks("LU.xls").Worksheets(1).Columns("A")
Set qw = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("G")
Set rw = Workbooks("LU.xls").Worksheets(1).Columns("B")
Set sd = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("C")
Set fd = Workbooks("LU.xls").Worksheets(1).Columns("C")
Set bu = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("N")
Set hu = Workbooks("LU.xls").Worksheets(1).Columns("D")
Set zx = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("R")
Set gx = Workbooks("LU.xls").Worksheets(1).Columns("E")
Set op = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("S")
Set wp = Workbooks("LU.xls").Worksheets(1).Columns("F")
Set ty = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("I")
Set ly = Workbooks("LU.xls").Worksheets(1).Columns("G")
sourceColumns.Copy Destination:=targetColumns
qw.Copy Destination:=rw
sd.Copy Destination:=fd
bu.Copy Destination:=hu
zx.Copy Destination:=gx
op.Copy Destination:=wp
ty.Copy Destination:=ly
End Sub
A simple way to neatly take user input is to use the InputBox function
Sub ReadInputBox()
Dim readWorkbookLocation As String
readWorkbookLocation = InputBox("What is the name of the workbook you wish to read from?", "Workbook Select")
MsgBox workbookFile
End Sub
Yup. You can use the Application.GetOpenFilename to let the user choose the file name. For example
Option Explicit
Sub Sample()
Dim Ret
Dim Wb As Workbook
Dim ws As Worksheet
Ret = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
If Ret <> False Then
Set Wb = Workbooks.Open(Ret)
Set ws = Wb.Sheets("Sheet1")
With ws
'
'~~> Do whatever you want to do here with the worksheet
'
End With
End If
End Sub
EDIT: I just noticed that You have tagged it as excel-vba-mac as well. If you are doing this on Excel 2011 then see this link which shows how to use the Application.GetOpenFilename. The rest of the code remains as it is.
For these type of operations, I use a separate Excel file that contains the vb codes. (I'll call this file "Operation"). On a worksheet put the name of the source/destination file. Add buttons such as "Select Source", "Select Destination", which would prompt for a file but put the selected filename on the sheet only. Another button "Go" will do the actual operation using the files specified, something like:
If the columns to be copied seldom change, you can leave it inside VBA. If it changes from time to time or you need several versions, put it on the Operation worksheet too. If you need a more complex scenario, you can put the configuration on another worksheet in the sources/destination workbooks, so authors can specify the columns themselves.
As a suggestion for your code, use constants/variable for the filenames, to minimize typing when changing filenames manually. Also assign to variables the Workbook and Worksheet being operated on.
' OPERATIONS SHEET
Dim operWB as Workbook
Dim operWS as Worksheet
Set operWB = Application.ActiveWorkbook
Set operWS = operWB.ActiveSheet
' SOURCE
Dim srcFN as string
' HARDCODED: same as before
'srcFN = "WERT_2013_01_24.xlsx"
' OR get from Cell C2
srcFN = operWS.Cell( 2, 3 )
Dim srcWB as Workbook
Dim srcWS as Worksheet
Set srcWB = Workbooks.Open( srcFN )
Set srcWS = srcWB.Worksheets( 0 )
' DESTINATION
.... do the same ...
.... OPTION 1: COPY ....
Set srcRange = srcWS.Columns( "L" ) ' <-- or get from B10
Set dstRange = dstWS.Columns( "A" ) ' <-- or get from C10
srcRange.Copy Destination:=dstRange
....
.... OPTION 2: COPY AS LOOP ....
Dim currentRow As Integer
currentRow = 10
' keep going while B10, B11... is not empty
While operWS.Cells(currentRow, 2) <> ""
Set srcRange = srcWS.Columns( operWS.Cells(currentRow, 2) ) ' B10, B11 ...
Set dstRange = dstWS.Columns( operWS.Cells(currentRow, 3) ) ' C10, C11 ...
srcRange.Copy Destination:=dstRange
currentRow = currentRow + 1
Wend
You may use the following simple code to loop over all the files in the folder without knowing their names and quantity:
LoopFileNameExt = Dir(InputFolder & "*.xls?")
Do While LoopFileNameExt <> ""
'your code here
LoopFileNameExt = Dir
Loop
Wildcards are allowed in filemask. Good luck!

Resources