So I have this code that will open a several csv workbooks (let's call this "Source file") listed in "RefData" sheet then copy its contents to destination file.
I have this code working but I'm not really impressed by how it is coded. I believe there's is much better way.
Private Sub OpenDL()
Dim i As Integer
Dim wrk As Workbook
Dim this As Workbook
lastrow = Sheets("RefData").Cells(Rows.Count, 1).End(xlUp).Row
Set wrk = ThisWorkbook
Sheets("RefData").Select
For i = 1 To lastrow
'open workbook
On Error Resume Next
Sheets(Sheets("RefData").Cells(i, 1).Value).Select
Workbooks.Open Filename:=Application.ActiveWorkbook.Path & "\" & "HistoricalPrices_" & Sheets("RefData").Cells(i, 1).Value & ".csv"
'copy Date, Open, High, Low, Close & Volume
Range("A1:" & Range("F1048576").End(xlUp).Address).Select
Selection.Copy
wrk.Activate
Sheets(Sheets("RefData").Cells(i, 1).Value).Select
Range("A1").Select
ActiveSheet.Paste
'close csv file
Application.DisplayAlerts = False
Workbooks("HistoricalPrices_" & Sheets("RefData").Cells(i, 1).Value & ".csv").Close
Application.DisplayAlerts = True
Next i
End Sub
The way how I code it is something like this:
based from the list in refdata column A, macro will open the source
file. the macro have to select A1 up to F + lastrow.
Screenshot of RefData sheet
Then it will copy it.
next is it will close the source file.
paste it to the destination file, in its correct sheet. Please note
that each item listed in Refdata column have its own sheet.
the macro ends.
My issue here is there an easy way to eliminate the step 2 and 3 where it will manually select the ranges then copy it?
I have an idea, not sure if its possible. it goes something like this:
sourcefile.sheets(sheets("refdata").cells(i,1).value).range("A1:F" & lastrow of the destination file).value **=** destinationfile.activesheets.range("A1:F" & lastrow of the destination file).value
something like:
the value of destination file > Sheet(Refdata).cells(I,1) > Range(A1 to F(x) is equal to the value of the Source File > activesheet > Range A1 to F(x)
where x = last row of the source file?
I'm not sure if this is possible. Any help is appreciated
wsDest.Range("A1:" & Range("F1048576").End(xlUp).Address).value = wsOrgn.Range("A1:" & Range("F1048576").End(xlUp).Address).value
However, you need to declare and set the wsDest (Destination worksheet) and wsOrgn (Origin worksheet). You can start with:
Dim wsDest As Worksheet, wsOrgn As Worksheet
and set the Worksheet based on the flow of the process:
'before you open the source, set the destination first
Set wsDest = wrk.Sheets(Sheets("RefData").Cells(i, 1).value)
'codes
'...
'once the source file opened and active on the sheet.
Set wsOrgn = ActiveSheet
'Transfer info from source to destination sheet
wsDest.Range("A1:" & Range("F1048576").End(xlUp).Address).value = wsOrgn.Range("A1:" & Range("F1048576").End(xlUp).Address).value
Range can be more precise by getting the last row from the origin and use it on both wsDest and wsOrgn.
P.S. Those PSE Stocks tho LOL.
Related
I want to copy dates from a sheet name MasterData which contain macro in a file sheet from other location name Data base .At the end I want to clear info from MasterData sheet and to close sheet Data base.
I run below code but nothing is happening.
Please can advise?
I'm kind new in running VBA code...
Thank you.
Mari
Sub Copy_Paste_Below_Last_Cell()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Workbooks.Open Filename:="D:\VBA\Test1\Prices_Database_ For_ Volume.xlsx"
'Set variables for copy and destination sheets
Set wsCopy = Workbooks("MacroMaster file.xlsm").Sheets("MasterData")
Set wsDest = Workbooks("Prices_Database_ For_ Volume.xlsx").Sheets ("DataBase")
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
'Offset property moves down 1 row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
wsCopy.Range("A2:AB100" & lCopyLastRow).Copy _
wsDest.Range("A" & lDestLastRow)
'Workbooks("Prices_Database_ For_ Volume.xlsx").Close SaveChanges:=True
'Workbooks("MacroMaster file.xlsm").Worksheets("MasterData").Range ("A2:AB100").ClearContents
End Sub
Hope is more ok now
Here is a modification of your code with out all the variables. It incorporates the last rows into each range.
Workbooks.Open Filename:="D:\VBA\Test1\Prices_Database_ For_ Volume.xlsx"
With ThisWorkbook.Sheets("MasterData")
Range("A2:AB" & Cells(Rows.Count, "A").End(xlUp).Row).Copy _
Destination:=Workbooks("Prices_Database_ For_ Volume.xlsx").Sheets("DataBase").Range("A" & Rows.Count).End(xlUp).Offset(1)
End With
I would like to copy a range in one sheet and paste it as a value in another sheet, but just in a specific range in the next available cell in column B. Starting from B4 to B23 only.
I changed some code I found online but it's not working for me in finding the next available row. After I run the macro the first time, when I run it again and again it does nothing, and it's not working in pasting only the values either.
I tried saving the file before running the Macro again, but still it's not working.
At the end, when the range in the Print sheet is full, I would like a message box asking me to select one of the printers (not the default) on one of my servers (specifying the server path in the code like \a_server_name) and print this Print Sheet only, or clear the records in the range in the Print Sheet, or save only the Sheet Print in a new file (SaveAs) to a location I can choose on one of my servers (specifying the server path in the code \a_server_name) or simply do nothing and end the sub.
Thank you.
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets(“Data”)
Set pasteSheet = Worksheets("Print”)
copySheet.Range("J11:Q11").Copy
pasteSheet.Range("B4:I23").End(xlUp).Offset(1,0)
.PasteSpecial.xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
This will set the values equal to each other without copying/pasting.
Option Explicit
Sub Testing()
Dim wsC As Worksheet: Set wsC = ThisWorkbook.Sheets("Data")
Dim wsP As Worksheet: Set wsP = ThisWorkbook.Sheets("Print")
Dim LRow As Long
LRow = wsP.Range("B" & wsP.Rows.Count).End(xlUp).Offset(1).Row
wsP.Range("B" & LRow).Resize(wsC.Range("J11:Q11").Rows.Count, wsC.Range("J11:Q11").Columns.Count).Value = wsC.Range("J11:Q11").Value
End Sub
Modifying your code - and reducing to minimal example
Sub test()
Dim copySheet As Worksheet: Set copySheet = Worksheets("Data")
Dim pasteSheet As Worksheet: Set pasteSheet = Worksheets("Print")
copySheet.Range("J11:Q11").Copy
pasteSheet.Range("B" & pasteSheet.Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End Sub
From what i can gather, you want to copy 8 cells and paste all 8 cells to 20 rows, starting at B4. You are not clear on how you want to rerun the macro, it will just write over the data you just pasted.
The first code will copy the 8 cells into the 20 rows
With ThisWorkbook
Sheets("Data").Range("J11:Q11").Copy
Sheets("Print").Range("B4:I23").PasteSpecial Paste:=xlPasteValues
End With
This second code uses a for loop to accoplish the same task, but it also will write over the previously pasted data.
Dim i As Long
With ThisWorkbook
For i = 4 To 23
Sheets("Data").Range("J11:Q11").Copy
Sheets("Print").Cells(i, 2).PasteSpecial Paste:=xlPasteValues
Next i
End With
If you want to be able to reuse the macro, you will have to modify the range to be copied that allows you to select the range you want to copy. Maybe a variable that allows a user input with a InputBox.
Edit:
Dim lRow As Long
lRow = Sheets("Print").Cells(Rows.Count, 2).End(xlUp).Row
With ThisWorkbook
Sheets("Data").Range("J11:Q11").Copy
Sheets("Print").Cells(lRow, 2).Offset(1).PasteSpecial Paste:=xlPasteValues
End With
Edit #3
With ThisWorkbook
Dim lRow As Long
lRow = .Sheets("Print").Range("B" & Rows.Count).End(xlUp).Row
Sheets("Data").Range("J11:Q11").Copy
Sheets("Print").Cells(lRow, 2).Offset(1).PasteSpecial Paste:=xlPasteValues
End With
sorry if this has been asked here many times. I am a beginner in vba excel, so I only have brief idea of how to begin the code. I am using Excel 2013.
I have 2 different workbooks, main and copy.
Row 1 to 4 will be empty.
Row 5 is meant for header/labeling the information it will be providing for both workbooks.
The "main" workbook will be using columns A to DN to store all the data.
If the cell contains "X" - it will copy column A to P, to the workbook "copy". After which, it will go on to the next row to determine the same thing.
If the cell is empty, it will proceed down to the next row to determine the same thing as well.
The code has to be dynamic as new information will be added every 3 months, such as new rows added or the criteria changing from "X" to empty, or empty to "X".
This is the code I have got as of now.
It works but since there are so many columns to check through, I was advised to do another code for this.
Sub copy()
Dim lr As Long, lr2 As Long, r As Long
lr = Sheets("main").Cells(Rows.Count, "A").End(xlUp).row
lr2 = Sheets("copy").Cells(Rows.Count, "A").End(xlUp).row
For r = lr To 2 Step -1
If range("Q" & r).Value = "X" Then
Rows(r).copy Destination:=Sheets("copy").range("A" & lr2 + 1)
lr2 = Sheets("copy").Cells(Rows.Count, "A").End(xlUp).row
End If
Next r
End Sub
For that you will have to declare two workbook variables and two worksheet variables to hold the source and destination workbooks and worksheets reference in the code.
Tweak the following code as per your requirement.
I have added the comments in the code which will help you to understand the flow of the program.
Further, more error handling can be used to make sure the source and destination sheets are found in source and destination workbook respectively.
If required, you can add the error handling as well.
Option Explicit
Sub CopyDatoToAnotherWorkbook()
Dim srcWB As Workbook, destWB As Workbook 'Variables to hold the source and destination workbook
Dim srcWS As Worksheet, destWS As Worksheet 'Variables to hold the source and destination worksheets
Dim FilePath As String 'Variable to hold the full path of the destination workbook including it's name with extension
Dim lr As Long, lr2 As Long, r As Long
Application.ScreenUpdating = False
Set srcWB = ThisWorkbook 'Setting the source workbook
Set srcWS = srcWB.Sheets("main") 'Setting the source worksheet
'Setting the FilePath of the destination workbook
'The below line assumes that the destination file's name is MyFile.xlsx and it is saved at your desktop. Change the path as per your requirement
FilePath = Environ("UserProfile") & "\Desktop\MyFile.xlsx"
'Cheching if the destination file exists, it yes, proceed with the code else EXIT
If Dir(FilePath) = "" Then
MsgBox "The file " & FilePath & " doesn't exist!", vbCritical, "File Not Found!"
Exit Sub
End If
'Finding the last row used in column A on source worksheet
lr = srcWS.Cells(Rows.Count, "A").End(xlUp).Row
'Opening the destination workbook and setting the source workbook
Set destWB = Workbooks.Open(FilePath)
'Setting the destination worksheet
Set destWS = destWB.Sheets("copy")
'Looping through rows on source worksheets
For r = lr To 2 Step -1
'Finding the first empty row in column A on destination worksheet
lr2 = destWS.Cells(Rows.Count, "A").End(xlUp).Row + 1
If srcWS.Range("Q" & r).Value = "X" Then
srcWS.Rows(r).copy Destination:=destWS.Range("A" & lr2 + 1)
End If
Next r
'Closing the destination workbook
destWB.Close True
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
I'm trying to figure out how to copy a dynamic range into a new workbook. The actual project is to generate monthly budget reports based on the user's choice of month. The overarching system tracks a number of budget lines, where each line has its own sheet, and each sheet holds 12 tables for the fiscal year for expenses to be input; it all feeds back into an annual budget sheet. Upon the user picking a month, a new workbook will be created, mirroring the number of sheets and filling each sheet with that month's table. Each table is a dynamic range.
What I've got below is a dry run to work out the mechanics, but the problem is that I cannot get the dynamic range to paste correctly:
Sub pasting()
On Error Resume Next
Dim x As Workbook
Dim y As Workbook
'set the budget tracking system as the active workbook
Set x = Workbooks("Save and copying proof of concept.xlsm")
'activate budget tracking system
x.Activate
Set y = Workbooks.Add
Dim z As Range
Dim w As Range
'test copying two cells in two sheets into new sheets in the new workbook
Set z = Workbooks("Save and copying proof of concept.xlsm").Sheets("Sheet1").Range("A1")
Set w = Workbooks("Save and copying proof of concept.xlsm").Sheets("Sheet2").Range("A1")
'call saveas option for monthly workbook
With y
Call save_workbook_newName
End With
'add 8 sheets to new workbook for 8 budget lines
Dim v As Worksheet
Dim i As Integer
For i = 1 To 7
Sheets.Add
Next i
'copy the specified range from the original sheet and into the newly created workbook.
z.Copy
y.Sheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteValues
w.Copy
y.Sheets("Sheet2").Range("A1").PasteSpecial Paste:=xlPasteValues
'copy a dynamic range to a new workbook
x.Worksheets("Sheet3").Activate
Dim xRow As Long, xColumn As Long
'determine the row and column limits of the dynamic range
Range("A100").End(xlUp).Select
xRow = ActiveCell.Row
Range("D").End(xlToLeft).Activate
xColumn = ActiveCell.Column
'select the range specified by the dynamic boundaries
Range(Cells(1, 1), Cells(xRow, xColumn)).Select
Selection.Copy
'activate newly created workbook
y.Worksheets("Sheet3").Activate
'paste into the new workbook
Selection.PasteSpecial Paste:=xlPasteAll, operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
End Sub
Sub save_workbook_newName()
Dim workbook_name As Variant
'display the SaveAs dialog box
'once a name is provided, the GetSaveAsFilename method gets the particular name and _
'assigns that name to the workbook_name variable
workbook_name = Application.GetSaveAsFilename
'if the user provides a filename, the true condition is executed, and if not (presses Cancel), the false condition is executed.
If workbook_name <> False Then
'the application.acriveworkbook property returns the workbooks to the current active window
'saves the file with the file name given by the user.
ActiveWorkbook.SaveAs Filename:=workbook_name & "xlsx"
Else
ActiveWorkbook.Close
End If
End Sub
This bit is the problematic code:
Range("A100").End(xlUp).Select
xRow = ActiveCell.Row
Range("D").End(xlToLeft).Activate
xColumn = ActiveCell.Column
'select the range specified by the dynamic boundaries
Range(Cells(1, 1), Cells(xRow, xColumn)).Select
It essentially only copies column A, even if it's told to activate column D and choose everything to the left of it (Columns A to C hold random numbers).
Using this method for selecting a dynamic range did not yield good results:
LR = Range("D1000").End(xlUp).Row
Set R1 = Range("D1:E" & LR)
Thanks, and I appreciate your help in this respect!
Another approach using .Resize. I think this method is a bit better than #Thomas Inzina because it goes along column and row headers (the .End methods) which are likely to not have empty cells. In Thomas'es example, if your data has empty cells in the last column, the code will copy incomplete table.
Sub copyTableIntoNewWorksheet()
' locate the dynamic range / table
Dim rngTable As Range
With ActiveSheet.[b2] ' top left cell of the dynamic range
Set rngTable = .Resize(Range(.Offset(0), .End(xlDown)).Rows.Count, _
Range(.Offset(0), .End(xlToRight)).Columns.Count)
End With
' create new worksheet
Dim wsNew As Worksheet
Set wsNew = Worksheets.Add
wsNew.Name = "New Sheet"
' copy table to new worksheet
rngTable.Copy wsNew.[a1] ' top left cell where to copy the table to
End Sub
The Range object can take two parameters Range([Cell1],[Cell2). Gereerally, you'll use the top left cell as first parameter and the bottom right cell as the second.
The first parameter of your code is Cells(1, 1) and the second is Cells(xRow, xColumn). The range will extend from Row 1 Column 1 to Row xRow, Column xColumn.
Range(Cells(1, 1), Cells(xRow, xColumn))
There is no need to select a range when copying and pasting. We can chain ranges methods together.
Here we set a range that starting in D100 extending to the leftmost column and then down to the last used cell in the list. We then copy it and paste it into y.Worksheets("Sheet3").Range("A1").
Foe example:
Dim rw As Long, Cell1 As Range, Cell2 As Range
Dim y As Workbook
Set x = Workbooks.Add
Set y = Workbooks("Book5.xlms")
rw = 100
Set Cell1 = Range("A" & rw)
Set Cell2 = Range("A" & rw).End(xlToRight).End(xlDown) 'This is the bottom left cell in the table
Set Target = Range(Cell1, Cell2)
Target.Copy x.Worksheets("Sheet1").Range("A1")
We can do all this on 1 line like this:
rw = 100
Range("D" & rw, Range("D" & rw).End(xlToRight).End(xlDown)).Copy y.Worksheets("Sheet3").Range("A1")
I'm trying to make a macro that allows the user to select a file (excel file) which then is used to copy down information to the active workbook from that selected file. I don't know how to include the file's variable directory into the code. Anyone got an idea?
Sub Ref()
Dim Path As String
Path = Application.GetOpenFilename
Dim r As Integer
r = 1
For r = 1 To 1000
If Not IsEmpty(Range(Path(Cells(r, 1)))) Then
Cells(r, 1) = Range(Path(Cells(r, 1)))
End If
Next
End Sub
It seems that you have a list of Excel workbooks together with their path(s) in column A. You are going to have to open the workbook if you want to retrieve information from the cell(s) in that workbook.
This generic framework should help you get started on a sub that loops through the values in the active workbook's active worksheet's column A, opens each file listed and transfers the value from A1 to the original workbook's column B.
Sub ref()
Dim wb0 As Workbook, wb1 As Workbook
Dim r As Long, lr As Long
Set wb0 = ActiveWorkbook
With wb0.Sheets("Sheet1")
lr = .Cells(Rows.Count, 1).End(xlUp).Row
For r = 1 To lr
If Not IsEmpty(.Cells(r, 1)) Then
Set wb1 = Workbooks.Open(.Cells(r, 1).Value2)
.Cells(r, 2) = wb1.Sheets("Sheet1").Cells(1, 1).Value
wb1.Close False
End If
Next r
End With
End Sub
You will have to expand on that for your own individual situation but I believe you should see the process as you loop through the workbooks listed in column A.