How to copy a range of cells - excel

I am trying to copy data from a closed Excel file to the workbook I am currently in. I would like to browse for the file and then have the macro do the rest.
I am getting an error in the target workbook that says
"Application-defined or object defined error."
Below is what I have so far. Target is the workbook I am opening and y is the current one, or should be at least!
Option Explicit
Sub getfilename()
Dim myFilePath As String
Dim target As Workbook, y As Workbook
myFilePath = Application.GetOpenFilename()
'copying
Set target = Workbooks.Open(myFilePath)
target.Sheets("Sheet1").Range("R9C2:R20C2").Copy
'pasting
Set y = ActiveWorkbook
y.Sheets("Adjustment").Cells("R57C4").PasteSpecial
'close
target.Close
End Sub

The RANGE object expects A1 notation rather than R1C1 notation. The CELLS object can use row number and column number (though you don't need the R..C.. structure there, either.
Sub getfilename()
Dim myFilePath As String
Dim target As Workbook, y As Workbook
myFilePath = Application.GetOpenFilename()
Set y = ActiveWorkbook
'copying
Set target = Workbooks.Open(myFilePath)
'Here we're using the A1 notation
target.Sheets("Sheet1").Range("B2","B9").Copy
'Here we're using the Row & Column numbers notation
y.Sheets("Adjustment").Cells(57, 4).PasteSpecial
'close
target.Close
End Sub
In addition, you don't actually need to use the Copy and PasteSpecial methods to duplicate values. It's not too big a deal in a small macro like this, but in a larger process you'd find it more efficient to duplicate the values directly using something like:
target.Range("A1","A10").value = source.Range("A1","A10").value

Related

How can I add sheets from an excel file to another?

So I am trying to write a Macro for Excel, that adds 2 worksheets from an excel file to a new one.
Therefore, I try this:
Sub addfile()
Dim sheet1 As Worksheet
Dim sheet2 As Worksheet
Set sheet1 = Sheets.Add(Type:="C:\Users\Helge\AppData\Roaming\Microsoft\Templates\page1.xltx")
Set sheet2 = Sheets.Add(Type:="C:\Users\Helge\AppData\Roaming\Microsoft\Templates\page2.xltx")
End Sub
When I test it, it imports the first page, but the 2nd page gives me a Runtime error 1004.
Why does this happen?
And is there another way to get 2 sheets from one excel file to another via vba?
Much to my surprise this version of your code actually worked for me.
Sub addfile()
Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet
Set Sheet1 = Sheets.Add(Type:=Environ("Userprofile") & "\OneDrive\Desktop\Template1.xltx")
Set Sheet2 = Sheets.Add(Type:=Environ("Userprofile") & "\OneDrive\Desktop\Book2.xlsx")
Debug.Print Sheet1.Name, Sheet2.Name
End Sub
The reason for my surprise is that Sheet1 and Sheet2 are the default CodeName for the first and second worksheets in any workbook. Therefore there is a conflict of naming between the Sheet1 in the workbook and the Sheet1 you declare which should come to the surface not later than Debug.Print Sheet1.Name. In fact, it may have. I didn't check which name was printed. But the code didn't crash. Since it crashes on your computer, perhaps you have an older version of Excel. Try to stay clear of variable names that Excel also uses. Or there is something wrong with the path & file name, which is hard to tell in that syntax and therefore kept me fooled for quite some time too.
In fact, I discovered the above only after finding out that my Desktop was on OneDrive and not before I had written the function below which is designed to avoid the use of Sheets.Add. It also has some extras such as being able to specify the sheet to take from the template (you could have one template with 2 or more sheets). You can specify an index number or a sheet name. And the function will give a name to the copy, too, if you specify one.
Private Function AddWorksheet(ByVal Template As String, _
TabId As Variant, _
Optional ByVal TabName As String) As Worksheet
Dim Wb As Workbook
Dim Path As String
Dim FileName As String
Set Wb = ThisWorkbook ' change to suit
' make sure the path ends on "\"
Path = "C:\Users\Helge\AppData\Roaming\Microsoft\Templates\"
With Workbooks.Open(Path & Template)
.Sheets(TabId).Copy After:=Wb.Sheets(Wb.Sheets.Count)
.Close
End With
Set AddWorksheet = ActiveSheet
If Len(TabName) Then ActiveSheet.Name = TabName
End Function
You can call the function from a sub routine like this:-
Sub AddWorksheets()
Dim Tab1 As Worksheet
Dim Tab2 As Worksheet
Application.ScreenUpdating = False
Set Tab1 = AddWorksheet("Page1.xltx", 1, "New Tab")
Set Tab2 = AddWorksheet("Page2.xltx", "Sheet1", "Another new Tab")
Application.ScreenUpdating = True
End Sub
Please observe the difference between the two function calls.

Changing Workbook Reference with VBA

Currently, I have a workbook without VBA, that pulls the maximum value from a specific range on a few different sheets in an external workbook. In the future, I would like to be able to frequently update the source workbook, while the sheet name and cell ranges will always be the same. For example, the following are a few of my current cell formulas:
=MAX(ABS(IF('[Test.xlsx]Page_3'!$B$6:$B$107<$B$8,'[Test.xlsx]Page_3'!$A$6:$A$107)))
=MAX(ABS(IF('[Test.xlsx]Page_4'!$B$6:$B$107<$B$8,'[Test.xlsx]Page_4'!$A$6:$A$107)))
Is there a way that I can define a sheet name, while still using these formulas in the cells? What I am envisioning is something like this:
Private Sub CommandButton1_Click()
Dim path As String
Dim wbk As Workbook
path = Application.GetOpenFilename()
Set wbk = Workbooks.Open(path)
End Sub
then I would be able to use that variable within the cells like this:
=MAX(ABS(IF('[wkb]Page_3'!$B$6:$B$107<$B$8,'[wkb]Page_3'!$A$6:$A$107)))
Is something like this possible? I would like to avoid coding all of my functions within the VBA window. I am much more comfortable with the syntax of the Excel functions.
Try the next code, please:
Sub testOpenWB_Formula()
Dim sh As Worksheet, path As String, wbk As Workbook, shortName As String
Set sh = ActiveSheet 'use here your sheet
path = Application.GetOpenFilename()
Set wbk = Workbooks.Open(path)
shortName = Split(path, "\")(UBound(Split(path, "\")))
sh.Range("A8").Formula = "=MAX(ABS(IF('[" & shortName & "]Page_3'!$B$6:$B$107<$B$8,'[" & _
shortName & "]Page_3'!$A$6:$A$107)))"
sh.Range("A9").Formula = "=MAX(ABS(IF('[" & shortName & "]Page_4'!$B$6:$B$107<$B$8,'[" & _
shortName & "]Page_4'!$A$6:$A$107)))"
End Sub
Take care to change the cells where the formulas to be placed ("A8" and "A9" in my test code).

is there a way i can copy the first characters of an excel filename and paste it in the worksheet?

i want to copy the the first 7 characters of my excel file name into a column in my summary sheet. my file name typically goes something like "PR_0001_nil_officer.xls". i want to copy the "PR_0001" and paste it in column range G2:G6 of my worksheet. Also Im very new to VBA so which makes this seemingly simple task more complex to me lol
Use ThisWorkbook.Name to get the workbook name.
Use the Left function to get the left 7 characters of that name
Write it to the range in your desired worksheet
ThisWorkbook.Worksheet("Summary").Range("G2:G6").Value = Left$(ThisWorkbook.Name, 7)
Option Explicit
Sub Test()
Dim strName As String
Dim wsSummary As Worksheet
With ThisWorkbook
Set wsSummary = .Worksheets("Summary")
strName = Left(.Name, 7)
wsSummary.Range("G2:G6").Value = strName
End With
End Sub

VBA - Based on identifiers, dynamically open workbooks in a directory & paste a value from each?

I have a few hundred or so excel files in a directory each with a unique identifier somewhere in the name, 103, 208c, 231a, etc. Identifiers are housed in a column in the workbook with the code. Based on these identifiers I'm trying to dynamically open the workbook containing the string of text and paste a single cell to be next to it's workbooks identifier.
I tried to get it to work for a single case below but after the would be dynamic file opens the macro ends rather than selecting the value and pasting it. If anyone has any suggestions on how to fix that or how to switch this code from single case to dynamic/loop based I'd greatly appreciate it. I'm relatively new to coding VBA. Normally only need to rarely read it/step thru existing code.
Option Explicit
Sub Process()
On Error Resume Next
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Dim sFound As String, fPath As String
Dim BaseFile As Workbook
Dim TestSheet As Worksheet
Dim WB1 As Workbook
Set TestSheet = ThisWorkbook.Sheets("TestSheet")
Set BaseFile = ThisWorkbook
fPath = "\\WhateverDirectory\"
sFound = Dir(fPath & "*231a*") '231a should be values in column B row 4 on in the TestSheet
If sFound <> "" Then
Set WB1 = Workbooks.Open(fPath & sFound)
WB1.Sheets("RCM").Range("D6").Copy
BaseFile.Activate
TestSheet.Range("C4").PasteSpecial xlPasteValues
End If

Copy one worksheet to multiple identical workbooks using VBA

I have a workbook containing one worksheet ("DB Output" or Sheet 34) which I would like to copy to several (around 45) files in within the same folder.
None of the target files have an existing sheet named "DB Output" - the objective is to find a way to insert a copy of this sheet, forumlas and all, into each one.
The range of cells on that sheet that needs to be copied to a sheet of the same name in each book is A1:PE5
The sheet contains references to cells in the book it is currently in, however as the files which I am seeking to copy the worksheet to all share the same template, I want the references to be to the local file, not the original one.
I've tried looking at RDBMerge, however it seems that is for merging sheets, and while I do want to do that, it will not help me do it multiple times quickly.
Likewise I have looked on SO for similar situations, this is the closest, however my attempts to adapt that code have failed as I only have a single workskeet. Never the less, as it is always useful to inlcude what you have already tried, here is my existing attempt:
Option Explicit
Public Sub splitsheets()
Dim srcwb As Workbook, trgwb As Workbook
Dim ws As Worksheet, t1ws As Worksheet
Dim rng1 As Range
Dim trgnm As String
Dim fpath As String
Application.ScreenUpdating = False
'--> Set this to the location of the target workbooks
fpath = "C:/file/path/"
Set srcwb = ThisWorkbook
For Each ws In srcwb.Worksheets
trgnm = ws.Name
'--> Change A1:B3 to the range to be copied to inside page
Set rng1 = srcwb.Sheets(trgnm).Range("A1:PE5")
Set trgwb = Workbooks.Open(fpath & trgnm & ".xlsm")
With trgwb
Set t1ws = .Sheets("DB Output")
End With
'--> Change A1:B3 to the range where you want to paste
rng1.Copy t1ws.Range("A1:PE5")
trgwb.Close True
Next
Application.ScreenUpdating = True
End Sub
However this starts with the first sheet in the workbook that contains DB Output (the sheet to be copied) and gives an error that "NameOfSheet1.xlsm" does not exist in that directory (which it does not).
Any help is much appreciated.
This should copy from the active workbook to all files in a directory. If you need help modifying it to fit your specific use let me know!
Edit: fixed code to only copy A1:PE5 and save each workbook.
Sub Example()
Dim path As String
Dim file As String
Dim wkbk As Workbook
path = "C:\Test\"
file = Dir(path)
Application.DisplayAlerts = False
Do While Not file = ""
Workbooks.Open (path & file)
Set wkbk = ActiveWorkbook
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "DB Output"
ThisWorkbook.Sheets("DB Output").Range("A1:PE5").Copy Destination:=wkbk.Sheets("DB Output").Range("A1")
wkbk.Save
wkbk.Close
file = Dir
Loop
Application.DisplayAlerts = True
End Sub
Please note that I did not add error handling so this could break if the active workbook is included in the directory you are trying to copy or if a sheet with the same name already exists in the workbook. If this is an issue let me know and I will add error handling.

Resources