I'm new to VBA and I've been trying to figure out how to open an input file and copy those contents to a hidden sheet on my workbook, I saw an example on how to do this but the number of rows and columns is static, and I have to use 3 different input files one of them that changes constantly so, although I've been trying to use my intuition on how to do this, I can't seem to find out the answer.
Here's it is:
Sub s()
' 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
' make weak assumption that active workbook is the target
Set targetWorkbook = Application.ActiveWorkbook
' get the customer workbook
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select an input file "
customerFilename = Application.GetOpenFilename(filter, , caption)
Set customerWorkbook = Application.Workbooks.Open(customerFilename)
' copy data from customer to target workbook
Dim targetSheet As Worksheet
Set targetSheet = targetWorkbook.Worksheets(1)
Dim sourceSheet As Worksheet
Set sourceSheet = customerWorkbook.Worksheets(1)
Dim lastRow As Long
lastRow = sourceSheet.Range("A" & Rows.Count).End(xlUp).Row
Dim lastColumn As Long
lastColumn = sourceSheet.Cells(1, Columns.Count).End(xlToLeft).Column
targetSheet.Range("A1:A" & lastRow).Value = sourceSheet.Range("A1:A" & lastRow).Value
' Close customer workbook
customerWorkbook.Close
End Sub
I'm using EXCEL 2007
I apologize in advance if this is an stupid noob question, but I honestly give up don't know what else to do to make it work.
The problem Is I don't know how to make it select first to last row and first to last cell (non blank both: cells and rows)
Tried this:
targetSheet.Range("A1:A" & lastRow).End(xlUp).Value = sourceSheet.Range("A1:A" & lastRow).End(xlUp).Value
and this targetSheet.Range("A1:A" & lastRow).End(xlRight).Value = sourceSheet.Range("A1:A" & lastRow).End(xlRight).Value
What about something like this:
SourceSheet.UsedRange.Copy TargetSheet.Range("A1")
Related
I have three workbooks.
One workbook is a list I add to every month, of things I need to delete from a second workbook. I receive a second workbook every month. The second workbook I receive always contains extraneous entries (the number growing every month) and will not be fixed anytime soon. There is no general filter I can make without making the second workbook useless, so I need to be really specific and have a silly cleaning list.
My third workbook is where I run all of my workbook cleaning macros from.
The objective is to compare the entries in column A or B on the first workbook with the entries in column A or B of the second workbook I receive. If any of the entries match, delete the entire row on the second workbook.
I will be doing this once a month for a few hundred lines, and it will be run from a macro assigned to a shape on a third workbook.
Here I am posting some code that lets me open my two files and copy the contents of one of them, but what I need is code that will compare and delete rows on Workbook 2 that match with Workbook 1. My own code to do exactly that is terrible, not worth posting at all.
Code:
Sub test()
Dim strFileName As String
Dim wbTarget As Workbook
Dim wbSource As Workbook
Dim wsTarget As Worksheet
Dim wsSource As Worksheet
strFileName = Application.GetOpenFilename("Excel files (*.xls*),*.xl*", Title:="Open data")
Set wbSource = ThisWorkbook
Set wbTarget = Workbooks.Open(strFileName)
Set wsSource = wbSource.Worksheets("Sheet1")
Set wsTarget = wbTarget.Worksheets("Sheet1")
'to copy from Target - > Source
wsTarget.Range("B2").Resize(5, 5).Copy wsSource.Range("B2")
'etc.
End Sub
Code, comment and suggestion is greatly appreciated!
Cheers,
Christopher
CODE UPDATE 8:30 AM: This is a new way I am thinking of making things work. I am getting a type mismatch error on the code line Set Rng = Range("A1:B10000" & LR)
Sub test()
Dim strFileName As String
Dim strFileName2 As String
Dim wbTarget As Workbook
Dim wbSource As Workbook
Dim wsTarget As Worksheet
Dim wsSource As Worksheet
Dim LR
Dim Rng As Range
strFileName = Application.GetOpenFilename("Excel files (*.xls*),*.xl*", Title:="Open 'Things Which Have Been Removed'")
strFileName2 = Application.GetOpenFilename("Excel files (*.xls*),*.xl*", Title:="Open This Month's Purge List")
Set wbSource = ThisWorkbook
Set wbTarget = Workbooks.Open(strFileName)
Set wsSource = wbSource.Worksheets("Sheet1")
Set wsTarget = wbTarget.Worksheets("Sheet1")
Set LR = wsSource.UsedRange.Rows
With wbTarget.Sheets(1)
Set Rng = Range("A1:B10000" & LR)
Rng.RemoveDuplicates Columns:=Array(4), Header:=xlNo
End With
End Sub
To answer your specific question.
Set Rng = Range("A1:B10000" & LR)
Should be
Set Rng = Range("A1:B" & LR)
I would like to help with your other issues, but your description is confusing, this is what I understand; you identify bad information in the second workbook and copy that information from the second workbook to the first workbook, then you want a macro to match what is in the first workbook to the second workbook and delete the rows in the second workbook that match. Question, why don't you delete the rows in the second workbook instead of copying them to the first workbook?
You can use find method ; after open workbook u can use this code, findind the cell adress u can easily delete it clear command
Dim GCell As Range
Set GCell = ActiveSheet.Cells.Find("yourvariable")
I have a workbook that generates pages/page names. The worksheet name always reflects a job number. The job number is also always displayed in cell A1.
I want to copy data from another book, and paste it back into this worksheet, but I need to target the page I want to paste the data.
My issue is that I can't say wbkDest.Worksheets("sheet1").
I need to say something like wbk.Dest.Worksheets(Range("a1").value).
So again: Paste in the sheet with the same name as cell A1 in the workbook the macro is triggered from.
sub import()
Dim wbkSrc As Workbook, wbkDest As Workbook
Dim myFile As String
Dim Path As String
Dim emptyRow As Long
Dim wsOrig As Worksheet
Set wsOrig = ThisWorkbook.Worksheets(1)
emptyRow = 1
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wbkDest = Workbooks("lathe_project6-1-2017.xlsm")
Path = "G:\FIXTURES\" & Range("A1").Value & "\lists\new folder\"
myFile = Dir(Path & "*.xls??")
Set wbkSrc = Workbooks.Open(Path & myFile)
wbkSrc.Worksheets(1).Range("A1:I100").Copy
wbkDest.Worksheets(wsOrig.Range("A1").Value).Cells(emptyRow, 1).PasteSpecial Paste:=xlPasteValues
wbkSrc.Close
End Sub
This doesn't work:?
Dim wskVariableSheet as worksheet
Set wskVariableSheet = wbkDest.Sheets(Range("a1").Value)
And then just reference to wskVariableSheet.range where you want to paste.
Currently I have a workbook that loops through workbooks in the same folder as it, end copies data from specific cells back to the master workbook. If I want to change to cells from where the code copies cells, I’ll have to change this value in the code.
However, I have co-workers who needs to use this sheet aswell, to collect data from other workbooks. – So I need to make this use friendly.
What I want to do, is to have the code read a cell value in the masterworkbook, and use this cell value as the cell that it copies from.
Example:
If I type “B3” in the masterworkbook cell A1 and run the macro, the macro will copy data from the originsheet B3, into the first cell of the masterworkbook. Does anyone have any idear how to accomplish this?
Or something like:
.Cells(1).Value = originsheet.Range(Range("CellValue from destinationsheet A1").Value).Value
Here is the code I use:
Sub Consolidate()
Dim wkbkorigin As Workbook
Dim originsheet As Worksheet
Dim destsheet As Worksheet
Dim ResultRow As Long
Dim Fname As String
Dim RngDest As Range
Set destsheet = ThisWorkbook.Worksheets("Sheet1")
Set RngDest = destsheet.Cells(Rows.Count, 1).End(xlUp) _
.Offset(1, 0).EntireRow
Fname = Dir(ThisWorkbook.Path & "/*.xlsx")
'loop through each file in folder (excluding this one)
Do While Fname <> "" And Fname <> ThisWorkbook.Name
If Fname <> ThisWorkbook.Name Then
Set wkbkorigin = Workbooks.Open(ThisWorkbook.Path & "/" & Fname)
Set originsheet = wkbkorigin.Worksheets(1)
With RngDest
.Cells(1).Value = originsheet.Range(Range("A1").Value).Value
.Cells(2).Value = originsheet.Range(Range("A2").Value).Value
.Cells(3).Value = originsheet.Range(Range("A3").Value).Value
.Cells(4).Value = originsheet.Range(Range("A4").Value).Value
.Cells(5).Value = originsheet.Range(Range("A5").Value).Value
End With
wkbkorigin.Close SaveChanges:=False 'close current file
Set RngDest = RngDest.Offset(1, 0)
End If
Fname = Dir() 'get next file
Loop
End Sub
And a picture of what i mean, in case im unclear:
enter image description here
I am sorry, but I believe you haven't made yourself clear. However, you may be trying to get something like this (correct me if I'm wrong):
destinationsheet.Range("A1") = originsheet.Range(destinationsheet.Range("A1"))
This will make the value in your Master Workbook be substituted by the content in cell address of the other worksheet.
I open two Workbooks that are part of the a 3D CAD file and have not real path.
Anyway, after I open them manually I want VBA to move, say, A1 from Workbook B To Workbook A.
In order for VBA to know the name of the source, I say the name of Workbook B is stored in B1 of Workbook A
I know how to move data if I have a path but since there is "none", how do I do that? Thank you!
Hope this help.
Dim FrmWorkbook As Workbook
Dim iCount As Integer
'Capture the source workbook
For i = 1 To ThisWorkbook.Application.Workbooks.Count
'change the name of your source Workbook below
If ThisWorkbook.Application.Workbooks(i).Name = "Book1.xlsx" Then
Set FrmWorkbook = ThisWorkbook.Application.Workbooks(i)
Exit For
End If
Next
'option 1: row by row or column by colum. (Column C)
Dim lRow As Long
For lRow = 1 To 100
ThisWorkbook.Sheets(1).Range("C" & lRow).Value = FrmWorkbook.Sheets(1).Range("C" & lRow).Value
Next
'option 2: copy the entire sheet (assuming Sheet1)
With FrmWorkbook.Sheets(1)
.Activate
.Select
.Copy before:=ThisWorkbook.Sheets(1)
End With
Set FrmWorkbook = Nothing
MsgBox "DONE"
After going back and forth i found out that this works too:
Private Sub import_Click()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set wb2 = ActiveWorkbook
Set ws2 = wb2.Sheets("sheet1")
Set wb1 = Workbooks(ActiveSheet.Range("n2").Value & ".xls")
Set ws1 = wb1.Sheets("input")
ws2.Range("a1") = ws1.Range("f90").Value
End Sub
Thank you for the good ideas
I can't get my formula to work. You can see that I am simply trying to subtract one value (there is a formula in the cells) from another from one workbook to another. What am I missing? It copies the formula in the correct cell but does not calculate. Results #NAME?.
Sub changeReports()
Dim currentWk As Worksheet
Dim prevYr As Worksheet
Dim prevWk As Worksheet
Dim File_Path As String
Dim Source_Workbook As Workbook
Dim Target_workbook As Workbook
File_Path = "B:\Operations\Aging 031416Wk11.xlsm"
Destination_Path = "B:\Operations\Aging 032116Wk12.xlsm"
Set Source_Workbook = Workbooks.Open(File_Path)
Set Target_workbook = Workbooks.Open(Destination_Path)
Set prevWk = Source_Workbook.Worksheets("2016 Reports")
Set currentWk = Target_workbook.Worksheets("2016 Reports")
currentWk.Activate
' code works to insert formula in cell but formula not working the way it is written
Range("chgBox").formula = "=currentWk.Range(""grBox"")- prevWk.Range(""grBox"")"
End Sub
If you want the result of the subtraction in the Range("chgBox") cell then performthe actual calculation.
Range("chgBox") = currentWk.Range("grBox") - prevWk.Range("grBox")
If you want the formula to remain in the Range("chgBox") cell then convert the VBA cell references to addresses and concatenate a string that will represent the worksheet formula.
Range("chgBox").Formula = "=" & currentWk.Range("grBox").Address(external:=true) & _
"-" & prevWk.Range("grBox").Address(external:=true)
You were getting the #NAME! error because the worksheet doesn't understand what currentWk.Range(""grBox"") is.
Addendum:
I've run through a full sample testing environment and both the formula and direct result work as provided above. I've cleaned up the remainder of the code below.
Option Explicit
Sub changeReports()
Dim currentWk As Worksheet
Dim prevWk As Worksheet
Dim filePath As String, destinationPath As String
Dim sourceWorkbook As Workbook, targetWorkbook As Workbook
filePath = "B:\Operations\Aging 031416Wk11.xlsm"
destinationPath = "B:\Operations\Aging 032116Wk12.xlsm"
filePath = Environ("TMP") & "\Aging 031416Wk11.xlsm"
destinationPath = Environ("TMP") & "\Aging 032116Wk12.xlsm"
Set sourceWorkbook = Workbooks.Open(filePath)
Set targetWorkbook = Workbooks.Open(destinationPath)
Set prevWk = sourceWorkbook.Worksheets("2016 Reports")
Set currentWk = targetWorkbook.Worksheets("2016 Reports")
With currentWk
.Range("chgBox") = .Range("grBox") - prevWk.Range("grBox")
'.Range("chgBox").Formula = "=" & currentWk.Range("grBox").Address & _
"-" & prevWk.Range("grBox").Address(external:=True)
End With
sourceWorkbook.Close savechanges:=False
targetWorkbook.Close savechanges:=True
End Sub