I am trying to copy all the used cells in an excel worksheet from a closed workbook into an already created worksheet in my current workbook using VBA.
Have seen lots of examples on copy the sheet as a new sheet but not just the used contents into an existing sheet.
Thanks!
Mike
Open the source workbook, using:
set wb = Workbooks.Open FileName:="fullPathAndFileName.xlsx", UpdateLinks:=0, ReadOnly:=True, AddToMru:=False
Using a reference to the sheet you want to copy, eg., wb.Sheets(1) (refers to the first sheet in the workbook), and a reference to your destination sheet, eg. destWorkSheet run a loop like this:
For Each cel in wb.Sheets(1).UsedRange.Cells
destWorkSheet.Cells(cel.Row, cel.Column) = cel
Next
This will copy the values cell by cell to the same location in the destination worksheet as they are in the source worksheet. You probably want to turn calculation off first. There are certainly other ways to do it as well.
You will still need to open the source workbook, but another approach is to do a direct write of Values. You can do this as long as the destination and source ranges are the same size and shape. This subroutine will do it for you:
Private Sub CopyValuesSourceToDest(src As Range, dest As Range)
'dest should be one cell, src can be a range of cells
If dest.Cells.Count <> 1 Then MsgBox "Only pass one cell as the destination.": Exit Sub
Dim rws As Long, cols As Long, trueDest As Range
rws = src.Rows.Count
cols = src.Columns.Count
Set trueDest = dest.Parent.Range(dest.Cells(1, 1), dest.Cells(1, 1).Offset(rws - 1, cols - 1))
trueDest.Value = src.Value
End Sub
You would then call the sub like this:
CopyValuesSourceToDest sourceSheet.UsedRange, destSheet.Range("B7") 'B7, or whatever
Related
I have a workbook that I need to create 150 copies of. I have the list of what I want to save each new workbook as in cells A1 to A150 in another workbook.
I've looked around but I can't find any code that does what I need. If it makes it easier, I could put the list into the template workbook, but would need to delete that sheet from each new workbook before saving and closing it.
This code should help you:
Sub Sample()
Dim wsToCopy As Worksheet, wsNew As Worksheet
With Sheets("Sheet1")
LastRow = Sheets("Sheet1").Cells(.Rows.Count, 1).End(xlUp).Row
For a = 1 To LastRow
Set wsToCopy = ThisWorkbook.Sheets("TemplateSheet")
Set wsNew = ThisWorkbook.Sheets.Add
wsNew.Name = Sheets("Sheet1").Cells(a, 1).Value
wsToCopy.Cells.Copy wsNew.Cells
Next
End With
End Sub
Explaining:
At a sheet named "Sheet1", you need to have a list of the to-create sheets names, starting at the first row, always in the first column.
The macro will create a new sheet, rename-it and copy everything from the sheet "TemplateSheet". And then, will pass to the next Sheet1's row.
So basically, just name your template sheet as "TemplateSheet" and add the 150 names at the first row of "Sheet1".
You can delete the template and the Sheet1 later.
I have a plethora of Excel workbooks containing 25+ worksheets each containing 20 columns of data from range 1:500 (or 1:1000 in some cases). Frequently I am tasked with updating the "template" onto which new data is entered for new calculations. I want to be able to easily paste extant data from old worksheets into sheets with new formatting while retaining any new formatting/formulas in the new templates.
I am using VBA to open the sheet I want to copy and paste it onto the new template sheet. So far my code will copy everything from the first sheet (S1) of the to-be-copied workbook and paste it onto the first sheet (S1) of the target workbook.
I want to extend this process to go through all active sheets (do whatever it is doing now for each sheet in the workbooks). I previously was able to do this with different code but it removed the formulas in rows 503 and 506 that I need when it pasted in. Can I do a pastespecial and skip empty cells? I am new to this.
Here is my current code:
Sub CopyWS1()
Dim x As Workbook
Dim y As Workbook
Set x = Workbooks("Ch00 Avoid.xlsx")
Set y = Workbooks("Ch00 Avoid1.xlsx")
Dim LastRow As Long
Dim NextRow As Long
x.Worksheets("S1").Activate
Range("A65536").Select
ActiveCell.End(xlUp).Select
LastRow = ActiveCell.Row
Range("A2:T" & LastRow).Copy y.Worksheets("s1").Range("A1:A500")
Application.CutCopyMode = False
Range("A1").Select
End Sub
I believe that I need to use something like the following code in order to extend this across the worksheets, but I'm not sure how to iterate through the sheets since I'm specifically referencing two sheets in my above code.
Sub WorksheetLoop2()
' Declare Current as a worksheet object variable.
Dim Current As Worksheet
' Loop through all of the worksheets in the active workbook.
For Each Current In Worksheets
' Insert your code here.
' This line displays the worksheet name in a message box.
MsgBox Current.Name
Next
End Sub
I imagine that I might be able to solve this as a for loop across an index of worksheets (make a new variable and run a for loop until my index is 25 or something) as an alternative, but again, I'm not sure how to point my copy/paste from a particular sheet to another sheet. I am very new to this with semi-limited experience with Python/Java only. These VBA skills would greatly benefit me on the day to day.
The two files in question:
Ch00 Avoid
Ch00 Avoid1
This should do it. You should be able to drop this in a blank workbook just to see how it works (put some values in column A on a couple of sheets). Obviously you will replace your wbCopy and wbPaste variables, and remove the wbPaste.worksheets.add from the code (my excel was only adding 1 sheet in the new workbook). LastRow is determined per your code, looking up from column A to find the last cell. wsNameCode is used to determine the first part of your worksheets you are looking for, so you will change it to "s".
This will loop through all sheets in your copy workbook. For each of those sheets, it's going to loop 1 through 20 to see if the name equals "s" + loop number. Your wbPaste has the same sheet names, so when it finds s# on wbCopy, it is going to paste into wbPaste with the same sheet name: s1 into s1, s20 into s20, etc. I didn't put in any error handling, so if you have an s21 on your copy workbook, s21 needs to be on your paste workbook, and NumberToCopy changed to 21 (or just set it to a higher number if you plan on adding more).
You could have it just loop through the first 20 sheets, but if someone moves one it will throw it all off. This way sheet placement in the workbook is irrelevant as long as it exists in the paste workbook.
You can also turn screenupdating off if you don't want to have a seizure.
Option Explicit
Sub CopyAll()
'Define variables
Dim wbCopy As Workbook
Dim wsCopy As Worksheet
Dim wbPaste As Workbook
Dim LastRow As Long
Dim i As Integer
Dim wsNameCode As String
Dim NumberToCopy As Integer
'Set variables
i = 1
NumberToCopy = 20
wsNameCode = "Sheet"
'Set these to your workbooks
Set wbCopy = ThisWorkbook
Set wbPaste = Workbooks.Add
'These are just an example, delete when you run in your workbooks
wbPaste.Worksheets.Add
wbPaste.Worksheets.Add
'Loop through all worksheets in copy workbook
For Each wsCopy In wbCopy.Worksheets
'Reset the last row to the worksheet, reset the sheet number search to 1
LastRow = wsCopy.Cells(65536, 1).End(xlUp).Row
i = 1
'Test worksheet name to match template code (s + number)
Do Until i > NumberToCopy
If wsCopy.Name = (wsNameCode & i) Then
wsCopy.Range("A2:T" & LastRow).Copy
wbPaste.Sheets(wsNameCode & i).Paste
End If
i = i + 1
Loop
Next wsCopy
End Sub
Thank you for all of your help, everyone. I went back yesterday afternoon from scratch and ended up with the following code which, at least to my eyes, has solved what I was trying to do. The next step will be to try to make this less tedious as I have a gajillion workbooks to update. If I can find a less obnoxious way to open/update/save/close new workbooks, I will be very happy. As it stands now, however, I have to open both the example workbook and the target workbook, save both, and close...but it works.
'This VBA macro copies a range of cells from specified worksheets within one workbook to a range of cells
'on another workbook; the names of the sheets in both workbooks should be identical although can be edited to fit
Sub CopyToNewTemplate()
Dim x As Workbook
Dim y As Workbook
Dim ws As Worksheet
Dim tbc As Range
Dim targ As Range
Dim InxW As Long
Dim WshtNames As Variant
Dim WshtNameCrnt As Variant
'Specify the Workbook to copy from (x) and the workbook to copy to (y)
Set x = Workbooks("Ch00 Avoid.xlsx")
Set y = Workbooks("Ch00 Avoid1.xlsx")
'Can change the worksheet names according to what is in your workbook; both worksheets must be identical
WshtNames = Array("S1", "S2", "S3", "S4", "S5", "S6", "S7", "s8", "s9", "S10", "S11", "S12", "S13", "S14", "S15", _
"S16", "S17", "S18", "S19", "S20", "Ext1", "Ext2", "Ext3", "EFS BigAverage")
'will iterate through each worksheet in the array, copying the tbc range and pasting to the targ range
For Each WshtNameCrnt In WshtNames
With Worksheets(WshtNameCrnt)
'tbc is tobecopied, specify the range of cells to copy; targ is the target workbook range
Set tbc = x.Worksheets(WshtNameCrnt).Range("A1:T500")
Set targ = y.Worksheets(WshtNameCrnt).Range("A1:T500")
Dim LastRow As Long
Dim NextRow As Long
tbc.Copy targ
Application.CutCopyMode = False
End With
Next WshtNameCrnt
End Sub
I'm not sure if this is possible, but it's the one thing I haven't found answered accross the web.
I created one template workbook Schedule.xls that will be filled out by different people, say personA, personB and personC. I need to extract the same range from each workbook by copying it and pasting it into a master file Master.xls, so that I can get the information from each person into this masterbook.
This Master.xls will have as much sheets as persons filling Schedule.xls.
For example, let's stay with those 3 persons: personA, personB and personC.
Once they generate their schedule, I want to get that information and copy it into Master.xls, but in separate sheets named personA, personB and personC.
I want to do this by setting a cell in Schedule.xls, say A1, where people can choose a value between personA, personB and personC.
This way I can create a dynamic reference for the sheet in Master.xls. in which the macro will paste the info.
`Range("B2.D5").Select
Selection.Copy
Workbooks.Open Filename:= _
"C:\My Documents\Master.xlsx"
Sheets(*REFERENCE*).Select
Range("B2").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWorkbook.Close`
What should I write instead of REFERENCE to set the sheet I want to write on?
Thanks in advance.
I'll suggest a simple, no-code approach. Then, I'll give you some VBA code for your specific request.
Place two workbooks, Carl's SlaveWB.xlsx and your Master.slxm, in the same folder for simplicity. Open the worksheet you want to sync (1-way copy) in both spreadsheets. Create these sheets manually for this simple example. Now, click in cell A1 in the master sheet. While in edit mode, type "=" then click in cell A1 in Carl's worksheet (in the other workbook). Your sheets are now linked. You can do this not just for A1 but the entire worksheet -- just copy/paste cell A1 to the entire worksheet. Now, Carl can take his workboook on the road. Here is how he check's in. He simply copies his latest workbook into your predesignated folder. When you open your master workbook, it will automatically pull in all the data from Carl's "checked-in" workbook.
If you prefer to copy from one workbook to another (to capture formatting), it is not difficult.
First, rename or delete the old "Carl" worksheet in master. Here is code for deleting a worksheet by name. If the name of the sheet in the master is stored in Carl's "Sheet1" worksheet, cell A1, you can pass this as the value of WSName: Workbooks("SlaveWB").Sheets("Sheet1").Cells(1,1).Value.
'DeleteWorksheet(WSName)
Public Function DeleteWorksheet(WSName As String)
'If Not IIf(IsNull(DebugMode), False, DebugMode) Then On Error GoTo FoundError
If Not Range("DebugMode").Value Then On Error Resume Next
Dim WorksheetExists As Boolean
DeleteWorksheet = False
'if no worksheet name provided, abort
If Len(WSName) < 1 Then Exit Function
'if worksheet exists, delete
WorksheetExists = False
On Error Resume Next
WorksheetExists = (Sheets(WSName).Name <> "") 'if worksheet exists, set WorksheetExists = True
On Error GoTo FoundError
If WorksheetExists Then Sheets(WSName).Delete 'if worksheet exists, delete
DeleteWorksheet = True 'function succeeded (deleted worksheet if it existed)
Exit Function
FoundError:
On Error Resume Next
DeleteWorksheet = False
Debug.Print "Error: DeleteWorksheet(" & WSName & ") failed to delete worksheet. "
End Function
Next, copy the revised worksheet from Carl's workbook to the master. The code below copies a worksheet from srcWBName to tgtWBName and names the sheet whatever you like in tgtWBName. I reocmmend you keep the code only only in the master spreadsheet. It is too risky to put the same code in every copy held by every user. And, it will be hard to manage code updates.
Sub CopyWSBetweenWBs(srcWBName As String, srcWSName As String, _
tgtWBName As String, tgtWSName As String)
'srcWBName - name of PersonA's workbook
'srcWSName - name of worksheet to copy from Person A's workbook
'tgtWBName - target workbook, the master
'tgtWSName - what you want to call the worksheet after copying it to the target/master.
' If you want this sheetname to be taken from a cell, just pass the cell
' reference. For example, this can be
' Workbooks(srcWBName).Sheets(srcWSName).Cells(1,1).Value
Dim srcWB As Workbook
Dim srcWS As Worksheet
Dim tgtWB As Workbook
Dim tgtWS As Worksheet
'Create XL objects
Set srcWB = Workbooks(srcWBName)
Set srcWS = srcWB.Worksheets(srcWSName)
Set tgtWB = Workbooks(tgtWBName)
Set tgtWS = tgtWB.Worksheets(tgtWSName)
' Start at the source
srcWB.Activate
srcWS.Activate
' Copy to target workbook
srcWS.Copy Before:=tgtWB.Sheets(1) '<~~ copy to beginning of workbook
' After copying the worksheet, it is active, so you can rename it now.
ActiveSheet.Name = tgtWSName
End Sub
That's it. I hope this helps.
I want to automatize a process which requires me looking up up to 20 workbooks and copying a cell if another cell is matching with the main workbook. I want to create something similar to Excel's built-in lookup function but is has to handle and loop through multiple workbooks. I've uploaded a screenshot which shows how the sheet ("Basis") in the main workbook looks like and an example of one of the sheets ("Report") that I copy the cell value from. The workbooks that contain the Report sheets (one sheet for every workbook) are stored in a folder locally.
So far I've tried to keep it simple by starting with one "Report Workbook" and then trying to copy the value over to the main workbook. This is how I want the logic to be: If there is a match between cell B10 (highlighted in red) in the reports sheet and one of the cells in range I4:I19 (highlighted in green), then the value in cell F13 should be copied in the Index column (highlighted in yellow), otherwise don't do anything. Loop and repeat procedure with every workbook in the folder.
In this particular case, there is a match for "200S", which means that the value 105 in cell F13 should be copied in cell L18. (Notice, that multiple routes can be in the same cell separated with a comma (just like here).
This is my code so far, and it works but I want it to loop through several workbooks in a fixed folder:
Sub CopyLookup()
Dim rng1 As Range, c1 As Range, rng2 As Range, c2 As Range
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lnLastRow1 As Long, lnLastRow2 As Long
'Create an object for each worksheet:
Set ws1 = Worksheets("Report")
Set ws2 = Worksheets("Basis")
'Get the row number of the last cell containing data in the basis sheet:
lnLastRow2 = ws2.Cells(ws2.Cells.Rows.Count, "A").End(xlUp).Row
'Create range objects for the two columns to be compared:
Set rng1 = ws1.Range("B10")
Set rng2 = ws2.Range("I4:I19")
'Loop through each cell in col I in sheet 2:
For Each c2 In rng2
'Check if the cell is not blank:
If c2.Value <> "" Then
'Loop through each cell in cell B10 in other sheet:
For Each c1 In rng1
'Test if cells match:
If c1.Value = c2.Value Then
'Copy value from sheet 1 to sheet 2 (main workbook):
c2.Offset(0, 3).Value = c1.Offset(3, 4).Value
'Move on to next cell in sheet 2:
Exit For '(exits the "For Each c1 In rng1" loop)
End If
Next c1
End If
Next c2
End Sub
The code has to be modified to handle separate workbooks (and not one workbook as it is done at the moment) and loop through several workbooks in the folder and compare them to the main workbook where the values are copied over.
I'm just giving you an example how to loop through the report Files.
This Code should be in the Basis Workbook. It Loops Through the RootFolder and adds all Files matching the Report.xslx File Pattern in the File Variable. Modify this as needed.
Dim File As Variant
Dim fileList As Collection
Dim RootFolder As String
Set fileList = New Collection
'Path of Folder to search for Reportfiles
RootFolder = "C:\Example\Path\"
'Modify *Report*.xlsx to match your Report File Names
File = Dir(RootFolder & "*Report*.xlsx")
'Loop Through all Report files
While File <> ""
'Add File to Collection
fileList.Add RootFolder & File
File = Dir
Wend
Dim FilePath As Variant
Dim objBasis As Workbook
Dim objReport As Workbook
'Set BasisFile
Set objBasis = ThisWorkbook
'Loop Through Report Files
For Each FilePath In fileList
'Open Workbook
Set objReport = Workbooks.Open(FilePath)
'#######################################################
'PASTE YOUR CODE HERE
'Example To access Values from Sheet in ReportFile
Debug.Print objReport.Sheets("Report").Cells(1, 1).Value
'#######################################################
'Close ReportFile without saving
objReport.Close False
Next FilePath
I have found similar questions that deal with copying an entire worksheet in one workbook and pasting it to another workbook, but I am interested in simply copying an entire worksheet and pasting it to a new worksheet -- in the same workbook.
I'm in the process of converting a 2003 .xls file to 2010 .xlsm and the old method used for copying and pasting between worksheets doesn't paste with the correct row heights. My initial workaround was to loop through each row and grab the row heights from the worksheet I am copying from, then loop through and insert those values for the row heights in the worksheet I am pasting to, but the problem with this approach is that the sheet contains buttons which generate new rows which changes the row numbering and the format of the sheet is such that all rows cannot just be one width.
What I would really like to be able to do is just simply copy the entire worksheet and paste it. Here is the code from the 2003 version:
ThisWorkbook.Worksheets("Master").Cells.Copy
newWorksheet.Paste
I'm surprised that converting to .xlsm is causing this to break now. Any suggestions or ideas would be great.
It is simpler just to run an exact copy like below to put the copy in as the last sheet
Sub Test()
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Master")
ws1.Copy ThisWorkbook.Sheets(Sheets.Count)
End Sub
ThisWorkbook.Worksheets("Master").Sheet1.Cells.Copy _
Destination:=newWorksheet.Cells
The above will copy the cells. If you really want to duplicate the entire sheet, then I'd go with #brettdj's answer.
' Assume that the code name the worksheet is Sheet1
' Copy the sheet using code name and put in the end.
' Note: Using the code name lets the user rename the worksheet without breaking the VBA code
Sheet1.Copy After:=Sheets(Sheets.Count)
' Rename the copied sheet keeping the same name and appending a string " copied"
ActiveSheet.Name = Sheet1.Name & " copied"
I really liked #brettdj's code, but then I found that when I added additional code to edit the copy, it overwrote my original sheet instead. I've tweaked his answer so that further code pointed at ws1 will affect the new sheet rather than the original.
Sub Test()
Dim ws1 as Worksheet
ThisWorkbook.Worksheets("Master").Copy
Set ws1 = ThisWorkbook.Worksheets("Master (2)")
End Sub
'Make the excel file that runs the software the active workbook
ThisWorkbook.Activate
'The first sheet used as a temporary place to hold the data
ThisWorkbook.Worksheets(1).Cells.Copy
'Create a new Excel workbook
Dim NewCaseFile As Workbook
Dim strFileName As String
Set NewCaseFile = Workbooks.Add
With NewCaseFile
Sheets(1).Select
Cells(1, 1).Select
End With
ActiveSheet.Paste
If anyone has, like I do, an Estimating workbook with a default number of visible pricing sheets, a Summary and a larger number of hidden and 'protected' worksheets full of sensitive data but may need to create additional visible worksheets to arrive at a proper price, I have variant of the above responses that creates the said visible worksheets based on a protected hidden "Master". I have used the code provided by #/jean-fran%c3%a7ois-corbett and #thanos-a in combination with simple VBA as shown below.
Sub sbInsertWorksheetAfter()
'This adds a new visible worksheet after the last visible worksheet
ThisWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
'This copies the content of the HIDDEN "Master" worksheet to the new VISIBLE ActiveSheet just created
ThisWorkbook.Sheets("Master").Cells.Copy _
Destination:=ActiveSheet.Cells
'This gives the the new ActiveSheet a default name
With ActiveSheet
.Name = Sheet12.Name & " copied"
End With
'This changes the name of the ActiveSheet to the user's preference
Dim sheetname As String
With ActiveSheet
sheetname = InputBox("Enter name of this Worksheet")
.Name = sheetname
End With
End Sub