I'm trying to run a macro that I can choose an Excel file where I can filter date and copy (in a specific sheet) and paste the data back to my active workbook (in a specific sheet).
I tried various forums about workbook.open errors but still couldn't get to fix my formula.
Sub CopyFilteredValuesToActiveWorkbook()
Dim wbSource As Workbook, wbDest As Workbook
Dim wsSource As Worksheet, wsDest As Worksheet
Dim rngSource As Range, rngDest As Range
Dim Fname As String
Dim strName As String 'for filter
Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File")
If Fname = "False" Then Exit Sub
Set wbSource = Workbooks.Open(Fname) 'ERROR POINTS THIS LINE
Set wsSource = wbSource.Worksheets("Table 1")
strName = InputBox("Input Year")
wsSource.Range("A:A").AutoFilter Field:=3, Criteria1:="=* & strName & *", Operator:=xlAnd
Set rngSource = wsSource.Range("A:K")
Set wbDest = ThisWorkbook
Set wsDest = wbDest.Worksheets("Sheet3")
Set rngDest = wsDest.Range("A:K")
rngDest.Value = rngSource.Value
wbSource.Close (False) 'Close without saving changes
End Sub
Related
So I would like to copy an external Set of Data from an external worksheet (source), but the source has a filter and has hidden some rows. Now the output i am hoping is that it copies all the data including the hidden ones. below is my code , where "ROCV" is the internal Destination sheet, and "PROJECT DETAIL" is the external data source:
(by the way, my first time here and also a very amateur VBA coder so please bear with me :D)
Option Explicit
Sub CopyOutput()
Dim wb1 As Workbook, wb2 As Workbook
Dim Ret1, Ret2
Set wb1 = ActiveWorkbook
'~~> Get the File
Ret1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
, "Please select file")
If Ret1 = False Then Exit Sub
Set wb2 = Workbooks.Open(Ret1, UpdateLinks:=False)
wb2.Sheets("PROJECT DETAIL").Range("a7").CurrentRegion.Copy Destination:=wb1.Worksheets("ROCV").Range("A7")
wb2.Close SaveChanges:=False
Set wb2 = Nothing
Set wb1 = Nothing
End Sub
Use ShowAllData
Sub test()
Dim wb1 As Workbook, wb2 As Workbook
Dim Ret1, Ret2
Dim Ws As Worksheet
Dim vDB As Variant
Set wb1 = ActiveWorkbook
'~~> Get the File
Ret1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
, "Please select file")
If Ret1 = False Then Exit Sub
Set wb2 = Workbooks.Open(Ret1, UpdateLinks:=False)
Set Ws = wb2.Sheets("PROJECT DETAIL")
If Ws.FilterMode Then
Ws.ShowAllData
End If
'** Receives values into a two-dimensional array, and assigns the values of the array back to the target worksheet.
vDB = Ws.Range("a7").CurrentRegion
wb1.Worksheets("ROCV").Range("A7").Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB
'Ws.Range("a7").CurrentRegion.Copy Destination:=wb1.Worksheets("ROCV").Range("A7")
'wb2.Sheets("PROJECT DETAIL").Range("a7").CurrentRegion.Copy Destination:=wb1.Worksheets("ROCV").Range("A7")
wb2.Close SaveChanges:=False
Set wb2 = Nothing
Set wb1 = Nothing
End Sub
I have 3 workbooks
source workbook
target workbook
reference workbook - (Containing the macro which visible across all workbooks)
Is it possible to change switch between Active workbook ( target workbook) and ( source workbook which was active workbook).
Activate doesn't seem to help me, I do not if this is a bug or what it is. I have stopped in this step for quite sometime now.
This workbook function takes me back to reference workbook.
Hope my question is clear. Appreciate your help.
' My code is in a test macroworkbook
' I am having a workbook opened 1.xlsx
' Opening a workbook countrypricelist.xls
'running the code from
Dim sourcewb As Workbook
Dim targetWorkbook As Workbook
Dim filter As String
Dim filter2 As String
Dim rw As Long
Dim x As Range
Dim y As Range
Set sourcewb = ActiveWorkbook
Set x = sourcewb.Worksheets(1).Range("A:F")
Dim sourceSheet As Worksheet
Set sourceSheet = sourcewb.Worksheets(1)
MsgBox sourceSheet.Name
x.Select
MsgBox sourceSheet.Name
x.Select
MsgBox sourcewb.Name ' This gives me sourceworkbook name.
filter = "(*.xls),*.xls"
Caption = "Please Select an input file "
Application.ScreenUpdating = False
Filename = Application.GetOpenFilename(filter, , Caption)
Set targetWorkbook = Application.Workbooks.Open(Filename)
Set y = targetWorkbook.Worksheets(1).Range("A:F")
y.Select
Dim targetSheet As Worksheet
Set targetSheet = targetWorkbook.Worksheets(1)
MsgBox targetSheet.Name
Set targetWorkbook = ActiveWorkbook
MsgBox targetWorkbook.Name 'This gives me target workbook name
y.Select
sourcewb.Activate
MsgBox sourcewb.Name ' Source workbook becomes same as targeworkbook.
x.Select
MsgBox sourcewb.Name & " This is the source workbook "
MsgBox targetWorkbook.Name & " This is the target workbook "
With sourcewb.Worksheets(1)
For rw = 2 To Cells(Rows.Count, 1).End(xlUp).Row
Cells(rw, 3) = Application.VLookup(Cells(rw, 2).Value2, x, 3, False)
Cells(rw, 4) = Application.VLookup(Cells(rw, 2).Value2, x, 4, False)
Cells(rw, 5) = Application.VLookup(Cells(rw, 2).Value2, x, 5, False)
Next rw
End With
MsgBox "All required columns from source mapped to target file "
MsgBox "Trying to map from target to source "
Set sourcewb = ActiveWorkbook
MsgBox ActiveWorkbook.Name
Application.ScreenUpdating = False
So If I change the line sourcewb = Thisworkbook my reference is changed to source code to workbook which is not my desired workbook as it contains many other macros for other activities. Hope this is code is fine.
The Excel Workbook Object allows you to programatically open, edit and close any workbook, not just the currently 'Activated' one.
Example:
Dim wb as Excel.Workbook, otherwb as Excel.Workbook
Dim ws as Excel.Worksheet, otherws as Excel.Worksheet
Set wb = Workbooks.Open "somefile.xlsx"
Set otherwb = Workbooks.Open "otherfile.xlsx"
Set ws = wb.Sheets(1)
Set otherws = otherwb.Sheets(1)
' do stuff
ws.Cells(1,1) = otherws.Cells(1,1)
'save changes
wb.Save
I want to search/loop through all the columns headers located on row 1 of the opened file and delete it if it matches dColumns, which is a list of columns I do not needed and I put in a range.
Sub LLextract()
'Last cell in column
Dim WS As Worksheet
Dim LastCell As Range
Dim LastCellRowNumber As Long
Set WS = ThisWorkbook.Worksheets("Consolidated Data")
With WS
Set LastCell = .Cells(.Rows.Count, "A").End(xlUp)
LastCellRowNumber = LastCell.Row + 0
End With
Dim wb As Workbook, wb2 As Workbook
Dim vFile As Variant
'Set source workbook
Set wb = ActiveWorkbook
'Open the target workbook
vFile = Application.GetOpenFilename("CSV Files (*.csv), *.csv", , _
"Select a CSV file", , False)
'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile
'Set selectedworkbook
Set wb2 = ActiveWorkbook
Dim dColumns As Range
Set dColumns = wb.Worksheets("LL Columns to Delete").Range("A:A")
Dim i As Integer
Dim A As Range
For i = 94 To 1 Step -1
Set A = wb2.Cells(1, i)
If wb2.Cells(1, i) = dColumns Then A.EntireColumn.Delete
Next i
'wb2.Worksheets(1).Range("A1").Select
End Sub
You can't do just Range("A"), replace that with Range("A:A").
(But what are you trying to do with dColumns?)
I solved it by just deleting the column when I open wb2. This question is no longer need to be answered or solved.
i am trying to replace the current data in my file with the data in any another selected file which have same attributes. i want to replace the data from A1:Q in the current file from any other selected file. I tried writing the code but its showing errors .
Sub newdata()
Set appxl = CreateObject("Excel.application")
Dim myfile As Window
Dim currentSheet As Worksheet
Dim lastRow As Double
Dim sourceFileName As String
'Open Source File.xlsx
With appxl
vFile = Application.GetOpenFilename(Title:="Select File To Be Opened")
If vFile = False Then Exit Sub 'if the user didn't select a file, exit sub
' Set myfile = Workbooks.Open(vFile)
.Visible = False
End With
'Get first sheet data
Set myfile = appxl.Windows(vFile)
myfile.Activate
Set currentSheet = myfile.Sheets(1)
'Past the table in my current Excel file
lastRow = currentSheet.Range("A1").End(xlDown).Row
Sheets("Data retrieval").Range("A1:E" & lastRow) = currentSheet.Range("A1:Q" & lastRow).Value
'Close Source File.xlsx
appxl.Workbooks(vFile).Close
End Sub
This is not the prettiest of codes but it works just as you asked!
Sub newdata()
Dim myfile As Window
Dim currentSheet As Worksheet
Dim lastRow As Double
Dim sourceFileName As String
Dim sourcefileworksheet As String
Dim destinationwb As String
Dim destinationwksheet As String
'set destination worksheet as open workbook when you run macro
destinationwb = ActiveWorkbook.Name
destinationwksheet = ActiveSheet.Name
'Select source file
Dim fNameAndPath As Variant, wb As Workbook
fNameAndPath = Application.GetOpenFilename(Title:="Select File To Be Opened")
' cancel macro if nothing selected
If fNameAndPath = False Then
MsgBox ("Nothing Selected, Macro Cancelled")
Exit Sub
End If
'Open Source File.xlsx
Workbooks.Open (fNameAndPath)
'set source names
sourceFileName = ActiveWorkbook.Name
sourcefileworksheet = ActiveSheet.Name
'Determine last row of source
lastRow = Workbooks(sourceFileName).Worksheets(sourcefileworksheet).Range("A1").End(xlDown).Row
'Past the table in my current Excel file - Note that you should change the range of destination to A1:Q if you want all copied
Workbooks(destinationwb).Worksheets(destinationwksheet).Range("A1:E" & lastRow) = Workbooks(sourceFileName).Worksheets(sourcefileworksheet).Range("A1:Q" & lastRow).Value
'Close Source File.xlsx
Workbooks(sourceFileName).Close
'Confirm complete
MsgBox ("Complete!")
End Sub
Thanks for all you're help. I've figured it out and have successfully come up with code to carry out what I needed. I have one more question, and hope you'd be able to help. Attached is my code, pay attention to the bold part. I want the sourceSheet to be copied as a sheet and pasted in the targetSheet (the Sheet2 of "NewBook") but I want it pasted as values. Here is the specific part which needs to be looked at...and below is the full code.
Set sourceBook = Application.Workbooks.Open(sourceFilename)
Set sourceSheet = sourceBook.Sheets("Current")
Set targetSheet = NewBook.Sheets("Sheet2")
sourceSheet.Copy targetSheet
Set targetSheet = NewBook.Sheets("Current")
targetSheet.Name = "Previous"
Sub Subtype()
Dim sourceBook As Workbook
Dim filter As String
Dim caption As String
Dim sourceFilename As String
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
If customerFilename = "False" Then
' GoTo Here:
End If
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select an input file "
sourceFilename = Application.GetOpenFilename
Set NewBook = Workbooks.Add
With NewBook
.Title = "Subtype Practice"
End With
Set sourceBook = Application.Workbooks.Open(sourceFilename)
Set sourceSheet = sourceBook.Sheets("Current")
Set targetSheet = NewBook.Sheets("Sheet2")
sourceSheet.Copy targetSheet
Set targetSheet = NewBook.Sheets("Current")
targetSheet.Name = "Previous"
sourceBook.Close
Dim sourceBook1 As Workbook
Dim sourceFilename1 As String
Dim sourceSheet1 As Worksheet
Dim targetSheet1 As Worksheet
sourceFilename1 = Application.GetOpenFilename
Set sourceBook1 = Application.Workbooks.Open(sourceFilename1, Password:="BMTBD")
Set sourceSheet1 = sourceBook1.Sheets("Data")
Set targetSheet1 = NewBook.Sheets("Sheet1")
sourceSheet1.Copy targetSheet1
Set targetSheet1 = NewBook.Sheets("Data")
targetSheet1.Name = "Current"
Application.DisplayAlerts = False
Sheets("Sheet1").Delete
Application.DisplayAlerts = True
End Sub
Your posted code doesn't quite match your description.
Untested:
Sub NewPractice()
Dim wbSrc as workbook, shtSrc as worksheet
Dim shtDest as worksheet
FileToOpen = Application.GetOpenFilename _
(Title:="Please Choose the RTCM File", _
FileFilter:="Excel Binary Worksheet *.xlsb (*.xlsb),")
If FileToOpen = False Then
MsgBox "No file specified.", vbExclamation, "Duh!!!"
Exit Sub
Else
Set shtDest = ActiveSheet
Set wbSrc = Workbooks.Open(FileName:=FileToOpen, PassWord:="passhere")
Set shtSrc = wbSrc.Sheets("Sheet1")
End If
shtDest.Range("A1:Z65536").ClearContents
lrow = shtSrc.Cells(Rows.Count, 1).End(xlUp).Row 'EDIT
shtDest.range("A1:Z" & lrow).Value = _
shtSrc.Range("A1:Z" & lrow).Value
End Sub
Try this. I'm not 100% what to do about passwords; I'll get back to you.
Sub FileImporter()
Dim sourceBook As Workbook
Dim targetBook As Workbook 'Add this
Dim filter As String
Dim caption As String
Dim sourceFilename As String
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
If customerFilename = "False" Then
GoTo Here:
End If
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select an input file "
sourceFilename = Application.GetOpenFilename(filter, , caption)
Set sourceBook = Application.Workbooks.Open(Filename:=sourceFilename, _
Password:=" ") 'The password goes here
Set sourceSheet = sourceBook.Sheets("Current")
Set targetBook = Workbooks(" ") 'The workbook you're copying TO goes here
Set targetSheet = targetBook.Sheets("Sheet2")
sourceSheet.Copy targetSheet
targetSheet.Name = "Previous"
sourceBook.Close
Here:
End Sub