I managed to get this working but some of my client files are protected.
Sub VBA_Read_External_Workbook()
' Get customer workbook...
Dim customerBook As Workbook
Dim filter As String
Dim caption As String
Dim customerFilename As String
Dim customerWorkbook As Workbook
Dim targetWorkbook As Workbook
Dim sheet As String
' make weak assumption that active workbook is the target
Set targetWorkbook = Application.ActiveWorkbook
' get the customer workbook
filter = "Text files (*.xlsb),*.xlsb"
caption = "Please Select an input file "
customerFilename = Application.GetOpenFilename(filter, , caption)
Set customerWorkbook = Application.Workbooks.Open(customerFilename)
sheet.Unprotect ("CADDRP")
' assume range is A1 - C10 in sheet1
' copy data from customer to target workbook
Dim targetSheet As Worksheet
Set targetSheet = targetWorkbook.Worksheets(1)
Dim sourceSheet As Worksheet
Set sourceSheet = customerWorkbook.Worksheets(3)
targetSheet.Range("A1", "C10").Value = sourceSheet.Range("D85", "D95").Value
' Close customer workbook
customerWorkbook.Close
End Sub
I squeezed sheet.unprotect inside.
It gives me an error
"Object Required" Run time error '424'.
I'm guessing I missed some variable declaration in the process?
Assuming you need to Unprotect the Sheet, not the Workbook.. Remove the sheet.Unprotect line where you have it currently and put it back in after setting the SourceSheet:
Set sourceSheet = customerWorkbook.Worksheets(3)
sourceSheet.Unprotect ("CADDRP")
Related
My code aims to import an .xls file selected by the user, and copy and paste it into my Data sheet in Book 1. This Book 1 has 2 sheets: Results and Data.
I want to run the code when I am in Results and here comes the problem.
When I run it in my Data sheet, after clearing the current sheet (Data) the file is imported and copied well.
However, when I import it when I am in the Results sheet, it comes an error according to the MsgBox Err.Description
What's wrong in the code?
Sub ImportData()
Dim customerBook As Workbook
Dim filter As String
Dim caption As String
Dim customerFilename As String
Dim customerWorkbook As Workbook
Dim targetWorkbook As Workbook
Dim wb As Workbook
On Error Resume Next
Set wb = Application.Workbooks("Book1.xlsm")
wb.Activate
wb.Sheets("Data").Range("A1:M5000").Select
Selection.ClearContents
Sheets("Data").Select
Range("A1").Select
Set targetWorkbook = Application.ActiveWorkbook
filter = "Text files (*.xls),*.xls"
caption = "Please Select an Input File "
customerFilename = Application.GetOpenFilename(filter, , caption)
Set customerWorkbook = Application.Workbooks.Open(customerFilename)
Dim targetSheet As Worksheet
Set targetSheet = targetWorkbook.ActiveSheet
Dim sourceSheet As Worksheet
Set sourceSheet = customerWorkbook.ActiveSheet
sourceSheet.UsedRange.Copy targetSheet.Range("A1")
sourceSheet.UsedRange.Value = sourceSheet.UsedRange.Value
targetSheet.Paste
customerWorkbook.Saved = True
customerWorkbook.Close
Sheets("Results").Select
End Sub
You may try it like this...
Sub ImportData()
Dim filter As String
Dim caption As String
Dim customerFilename As Variant
Dim customerWorkbook As Workbook, targetWorkbook As Workbook
Dim targetSheet As Worksheet, sourceSheet As Worksheet
Set targetWorkbook = Application.Workbooks("Book1.xlsm")
Set targetSheet = targetWorkbook.Sheets("Data")
targetSheet.Range("A1:M5000").ClearContents
filter = "Text files (*.xls),*.xls"
caption = "Please Select an Input File "
customerFilename = Application.GetOpenFilename(filter, , caption)
If customerFilename = False Then
MsgBox "No Customer File was selected.", vbExclamation
Exit Sub
End If
Set customerWorkbook = Application.Workbooks.Open(customerFilename)
Set sourceSheet = customerWorkbook.ActiveSheet
sourceSheet.UsedRange.Copy
targetSheet.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = 0
sourceSheet.UsedRange.Value = sourceSheet.UsedRange.Value
customerWorkbook.Saved = True
customerWorkbook.Close
targetWorkbook.Sheets("Results").Select
End Sub
The following code:
wb.Sheets("Data").Range("A1:M5000").Select
Selection.ClearContents
Should be replaced with:
wb.Sheets("Data").Range("A1:M5000").ClearContents
The same goes for all similar lines. Operating on selection most often comes from macro recorder, is a very unreliable and slow method. It's dependent on currently selected range or object and non-transparent in the code, as it forces to know what is currently selected / active.
Selecting should be done only to leave selected worksheet or cell active in the end of macro operation or to perform actions on ActiveWindow.
Likewise, try to eliminate ActiveSheet:
Set targetSheet = targetWorkbook.ActiveSheet
And replace it with one of the following examples:
Set targetSheet = targetWorkbook.Worksheets(1) '1st worksheet in the file
Set targetSheet = targetWorkbook.Worksheets("myData") 'worksheet named "myData"
I'm pretty new to VBA and need some help with a project. I need to write a macro that reads the Sheet Name in Column C, and pastes the values from a source workbook to a range in a target workbook, which is specified in Column D.
So for example, it needs to copy the data in Sheet2 of Myworkbook book, and paste it into range of Theirworkbook Sheet2. The place where the range and sheet number information is stored in a separate workbook.
Edit: I've added a picture of what wbOpen looks like. This is it here.
Option Explicit
Sub PasteToTargetRange()
Dim arrVar As Variant 'stores all the sheets to get the copied
Dim arrVarTarget As Variant 'stores names of sheets in target workbook
Dim rngRange As Range 'each sheet name in the given range
Dim rngLoop As Range 'Range that rngRange is based in
Dim wsSource As Worksheet 'source worksheet where ranges are found
Dim wbSource As Workbook 'workbook with the information to paste
Dim wbTarget As Workbook 'workbook that will receive information
Dim strSourceFile As String 'location of source workbook
Dim strTargetFile As String 'location of source workbook
Dim wbOpen As Workbook 'Current open workbook(one with inputs)
Dim wsRange As Range 'get information from source workbook
Dim varRange As Range 'Range where values should be pasted
Dim i As Integer 'counter for For Loop
Dim wbkNewSheet As Worksheet 'create new worksheet if target workbook doesn't have
Dim wsTarget As Worksheet 'target workbook worksheet
Dim varNumber As String 'range to post
Set wbOpen = Workbooks.Open("WorkbookWithRanges.xlsx")
'Open source file
MsgBox ("Open the source file")
strSourceFile = Application.GetOpenFilename
If strSourceFile = "" Then Exit Sub
Set wbSource = Workbooks.Open(strSourceFile)
'Open target file
MsgBox ("Open the target file")
strTargetFile = Application.GetOpenFilename
If strTargetFile = "" Then Exit Sub
Set wbTarget = Workbooks.Open(strTargetFile)
'Activate transfer Workbook
wbOpen.Activate
Set wsRange = ActiveSheet.Range("C9:C20")
Set arrVarTarget = wbTarget.Worksheets
For Each varRange In wsRange
If varRange.Value = 'Target workbook worksheets
varNumber = varRange.Offset(0, -1).Value
Set wsTarget = X.Offset(0, 1)
wsSouce.Range(wsTarget).Value = varNumber
Else
wbkNewSheet = Worksheets.Add
wbkNewSheet.Name = varRange.Value
End If
Next
End Sub
Something like this (untested but should give you an idea)
Sub PasteToTargetRange()
'....omitted
Set wsRange = wbOpen.Sheets(1).Range("C9:C20")
For Each c In wsRange
shtName = c.Offset(0, -1).Value
Set wsTarget = GetSheet(wbTarget, shtName) 'get the target sheet
wbSource.Sheets(shtName).Range(c.Value).Copy wsTarget.Range(c.Value)
Next
End Sub
'Get a reference to a named sheet in a specific workbook
' By default will create the sheet if not found
Function GetSheet(wb As Workbook, ws As String, Optional CreateIfMissing As Boolean = True)
Dim rv As Worksheet
On Error Resume Next 'ignore eroror if no match
Set rv = wb.Worksheets(ws)
On Error GoTo 0 'stop ignoring errors
'sheet wasn't found, and should create if missing
If rv Is Nothing And CreateIfMissing Then
Set rv = wb.Worksheets.Add(after:=wb.Worksheets(wb.Worksheets.Count))
rv.Name = ws
End If
Set GetSheet = rv
End Function
I am working on a excel newly jfor 1 weeks where i want to compare opened excel file current open file,
I made all possible but whenever I try to read the row, it only reading the value from the opened , I cant' able to access to read current workbook where i my macro was coded
Sub test1()
Dim iComp
Dim sheet As String
Dim wbTarget As Worksheet
Dim wbThis As Worksheet
Dim bsmWS As Worksheet
Dim c As Integer
Dim x As Integer
Dim strValue As String
Static value As Integer
Dim myPath As String
Dim folderPath As String
k = 3
Filename = Application.GetOpenFilename("Excel files (*.xls*),*.xl*", Title:="Open data") ' Choosing the Trigger Discription
'Set wbTarget = ActiveWorkbook.ActiveSheet
Set theRange = Range("A2:A4")
c = theRange.Rows.Count
strValue = vbNullString
For x = 1 To c
strValue = strValue & theRange.Cells(x, 1).value
Next x
'Set tabWS = Sheets("Tabelle1")
folderPath = Application.ActiveWorkbook.Path
myPath = Application.ActiveWorkbook.FullName
Set bsmWS = Sheets("Tabelle1")
Set wbkA = Workbooks.Open(Filename:="myPath")
Set varSheetA = wbkA.Worksheets("Balance sheet").Range(strRangeToCheck)
Its a 1000 line code , I just put only snippet.
I have myworksheet in the workbook where I am programed . I want to open another worksheet, take the value and compare it with my current worksheet . If string matches (ex range (A1:A2)) then msgbox yes
Have you tried using ThisWorkbook.Sheets("sheet name").Range("A2:A4") or ThisWorkbook.ActiveSheet.Range("A2:A4"). This will ensure the reference is to the workbook where the code is located.
More info on Application.ThisWorkbook
https://msdn.microsoft.com/en-us/library/office/ff193227.aspx.
I have to copy and paste specific columns from one worksheet in workbook1 to another worksheet in the same workbook1 or it may be workbook2 also. I mean I want to dynamically select the source workbook and worksheet and also the destination workbook and worksheet. I must be able to select the columns that I want to copy also dynamically.
I've tried this:
Dim thisWb As Workbook
Dim destWb As String
Dim destSheet As Worksheet, FromSheet As Worksheet
Dim FromBook As String
Set thisWb = ThisWorkbook
Set destSheet = thisWb.ActiveSheet
FromBook = Application.GetOpenFilename
If FromBook = "False" Then Exit Sub
destWb = Application.GetOpenFilename
Workbooks.Open Filename:=destWb
Set FromSheet = destWb.Worksheets("Sheet1")
Set sourcecolumn = Workbooks("FromBook").Worksheets("sheet1").Columns("A")
Set targetcolumn = Workbooks("destWb").Worksheets("sheet2").Columns("B")
sourcecolumn.Copy Destination:=targetcolumn
There is an "invalid specifier" compile time error and destwb is highlighted on this line:
Set FromSheet = destwb.Worksheets("Sheet1")
i have tried doing this with static workbooks,worksheets,column names and it works.
Dim sourcecolumn As Range, targetcolumn As Range
Set sourcecolumn = Workbooks("Book1.xlsm").Worksheets("sheet1").Columns("A")
Set targetcolumn = Workbooks("Book1.xlsm").Worksheets("sheet2").Columns("B")
sourcecolumn.Copy Destination:=targetcolumn
The problem is i want to select the workbooks,worksheets and columns dynamically...
There is some type confusion in your variable declarations. On the line on which you get the error, you're trying to assign a Worbook object reference to a String variable. This doesn't work because those are two different data types.
Here's a fix. I commented the lines that I changed:
Dim pthFromBook As String
Dim pthDestWb As String ' to store the path of the workbook file
Dim thisWb As Workbook
Dim destWb As Workbook ' to store reference to workbook object
Dim destSheet As Worksheet, FromSheet As Worksheet
Set thisWb = ThisWorkbook
Set destSheet = thisWb.ActiveSheet
pthFromBook = Application.GetOpenFilename
If pthFromBook = "False" Then Exit Sub
pthDestWb = Application.GetOpenFilename ' first get the path
Set destWb = Workbooks.Open(pthDestWb) ' then open the workbook
Set FromSheet = destWb.Worksheets("Sheet1")
Finally, I don't know if it's a typo, but on the last line above, there appears to be some confusion between From and Dest sheets/workbooks...
I am attempting to create a subroutine that prompts the user to select a workbook and then adds the first worksheet of the selected workbook as a tab in the existing (active) workbook. Then names the new tab "Data". Here is the code I am using so far:
Sub getworkbook()
' Get workbook...
Dim ws As Worksheet
Dim filter As String
Dim targetWorkbook As Workbook
Set targetWorkbook = Application.ActiveWorkbook
' get the customer workbook
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select an input file "
ws = Application.GetOpenFilename(filter, , caption)
ws.Add After:=Sheets(Sheets.Count)
ws.Name = "DATA"
End Sub
This code doesn't seem to be working and is returning the following error:
"ws.Add" method or With Block not set.
Any help is appreciated.
Thanks,
You have declared ws as a worksheet and GetOpenFilename is returning a File name. I would recommend reading my post in this link:
Is this what you are trying?
Note: I have not done any error handling. I am sure you can take care of that.
Sub getworkbook()
' Get workbook...
Dim ws As Worksheet
Dim filter As String
Dim targetWorkbook As Workbook, wb As Workbook
Dim Ret As Variant
Set targetWorkbook = Application.ActiveWorkbook
' get the customer workbook
filter = "Text files (*.xlsx),*.xlsx"
Caption = "Please Select an input file "
Ret = Application.GetOpenFilename(filter, , Caption)
If Ret = False Then Exit Sub
Set wb = Workbooks.Open(Ret)
wb.Sheets(1).Move After:=targetWorkbook.Sheets(targetWorkbook.Sheets.Count)
ActiveSheet.Name = "DATA"
End Sub