copying ranges from workbooks (without folder path version) - vba

I've recently been looking for ways to speed up copying data from one worksheet to another. And I came across this nice piece of code (however this was posted in 2013).
Could you please help? I don't want to specify any path to workbooks (like in the example below). I have both worksheets open and would like to address them by filename.
I've tried changing "workbooks.open" to "window("xxx").activate" but that doesn't work.
thank you!
Sub foo()
Dim x As Workbook
Dim y As Workbook
'## Open both workbooks first:
Set x = Workbooks.Open(" path to copying book ")
Set y = Workbooks.Open(" path to destination book ")
x.Sheets("name of copying sheet").Range("A1").Copy
y.Sheets("sheetname").Range("A1").PasteSpecial
End Sub

Sub foo()
Dim x As Workbook
Dim y As Workbook
'Replace the text between the "" with the exact name of the workbook
Set x = Workbooks("ActualNameOfWorkBook.xls")
Set y = Workbooks("ActualNameOfOtherWorkBook.xls")
x.Sheets("name of copying sheet").Range("A1").Copy
y.Sheets("sheetname").Range("A1").PasteSpecial
End Sub

When using PasteSpecial you need to add the XlPasteTypewhat (what parameter/s from the copied range you want to use). Some options of XlPasteTypewhat are: xlPasteAll , xlPasteFormulas, xlPasteValues etc.
You can read more about it at MSDN.
In the example below I am using xlPasteAll.
Code
Sub foo()
Dim x As Workbook
Dim y As Workbook
'## Open both workbooks first:
Set x = Workbooks.Open("file_name_x.xslx") '<-- don;t forget to add the extension, .xslx or .xlsm
Set y = Workbooks.Open("file_name_y.xslx") '<-- don;t forget to add the extension, .xslx or .xlsm
x.Sheets("name of copying sheet").Range("A1").Copy
y.Sheets("sheetname").Range("A1").PasteSpecial xlPasteAll '<-- add parameter after the PasteSpecial
End Sub

Related

VBA Macro: Copying worksheets from one Excel file to another

I need help on copying worksheets from one excel workbook to another. Currently, this is my code but it does not run:
Sub Code()
Workbooks.Open Filename:="C:\Users\xxx\Desktop\w1.xlsm"
Sheets (Array("Sheet1", "Sheet2"))
Copy after:=Workbooks("w2.xlsm").Sheets(Sheets.Count)
Workbooks("Client Info Template.xlsm").Close savechanges:=False
End Sub
Instead of Sheets... and Copy ... as two lines, try a single line:
Sheets(Array("Sheet1", "Sheet2")).Copy After:=Workbooks("w2.xlsm").Sheets(Sheets.Count)
This probably still won't work, or at least not reliably, because Sheets.Count may exceed the count of sheets in the destination workbook, so it is better to fully qualify all of your objects:
Sub Code()
Dim w1 as Workbook, w2 as Workbook
Set w1 = Workbooks.Open(Filename:="C:\Users\xxx\Desktop\w1.xlsm")
Set w2 = Workbooks.Open(Filename:="C:\Users\xxx\Desktop\w2.xlsm") '## Modify as needed
w1.Sheets(Array("Sheet1", "Sheet2")).Copy After:=w2.Sheets(w2.Sheets.Count)
End Sub

Copy from a closed workbook to an open workbook

I'm trying to create code to copy from an unopened excel workbook to an open book.
This is the code I've been using:
Sub foo()
Dim x As Workbook
Dim y As Workbook
Set x = Workbooks.Open("R:\Manufacturing\First Off Log\First Off Log.xlsm", ReadOnly:=True)
Set y = Workbooks.Open("R:\Manufacturing\First Off Log\Analysis\First Off Log Analysis.xlsm")
x.Sheets("Sheet1").Range("A:K").Copy
y.Sheets("Data Input").Range("A:K").PasteSpecial
'Close x:
x.Close
End Sub
'First Off Log Analysis' will already be open. The code above reopens the workbook and causes it to crash!
Any help would be really appreciated!
Thank you! :-)
Concerning that First Off Log.xlsm is the workbook where the code is placed, it is opened already. Thus instead of:
Set x = Workbooks.Open("R:\Manufacturing\First Off Log\First Off Log.xlsm", ReadOnly:=True)
write
Set x = ThisWorkbook

VBA: How to extend a copy/paste between two workbooks to all sheets of both workbooks

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

Paste Values into new worksheet for all Open Worksheets including pictures

I am trying to create a renamed copy of all active workbooks (even non macro-enabled ones) without formulas, possibly by pasting values but without modifying images. I am working with Excel 2007.
My process would ideally be to:
1) Create a do while there are xls files loop that converts all xls files to xlsm. One possible addition would be an array to store A)the worksheet name(s) B)Its tabs name and their status
2) Run a for each or for loop that automatically pastes values for all active worksheets include those with graphs or other images into a new document that has the same name with all small addition at the end.
3) Convert my newly-named files containing values only into xls.
One issue I am running into when I try to do this has to do with links. The initial worksheets have formulas with links that do not automatically update. When I do this, the formulas in the original worksheet with link references tend to get corrupted.
Here is a general macro I found for pasting values:
Sub test()
Dim MyNames As Range, MyNewSheet As Range
Set MyNames = Range("R5").CurrentRegion ' load contigeous range into variable
For Each MyNewSheet In MyNames.Cells ' loop through cell children of range variable
Sheets.Add.Name = MyNewSheet.Value
Next MyNewSheet
MyNames.Worksheet.Select ' move selection to original sheet
End Sub
I think this is what you're asking for:
Sub test()
Dim wb As Workbook
Dim ws As Worksheet
Dim counter As Integer
Dim filePath As String
Set wb = ActiveWorkbook
countet = 1
filePath = "c:/" 'Enter your destination folder here
For Each ws In wb.Sheets
Sheets("Sheet1").Copy
With ActiveSheet.UsedRange
.Value = .Value
End With
ActiveWorkbook.SaveAs filePath & counter & ".xlsx", FileFormat:=51
counter = counter + 1
Next ws
End Sub
This is mostly taken from here.
The counter is a bit of a hack to make sure that the files aren't all being saved as the same name and overwriting each other. Maybe there's a more appropriate way that you can get around this.

How to copy and paste rows from workbook to another with non consecutive rows

Private Sub CommandButton21_Click()
Dim x As Workbook
Dim y As Workbook
'## Open both workbooks first:
Set x = Workbooks.Open("Name of Copied Document")
Set y = Workbooks.Open("Name of Pasted Document")
'Now, copy what you want from x:
x.Sheets("Report Data").Range("A7:ax7").Copy
'Now, paste to y worksheet:
y.Sheets("Jan").Range("A7:ax7").PasteSpecial
'Close x:
x.Close
End Sub
I am using this code to copy and paste rows from existing data to another work book in the same respective row. I want to Copy from A7:AX7 and also from A23:ax23, but do not want the rows between. With the end result being the copied data goes in the same row that its on from X sheet to Y sheet.
Simple way would just be to iterate over your operation ranges using a loop. This way you don't have to copy-paste code:
Private Sub CommandButton21_Click()
Dim x As Workbook
Dim y As Workbook
'## Open both workbooks first:
Set x = Workbooks.Open("Name of Copied Document")
Set y = Workbooks.Open("Name of Pasted Document")
Dim rangeCells As Variant
For Each rangeCells In Split("A7:AX7,A23:AX23", ",")
'Now, copy what you want from x:
x.Sheets("Report Data").Range(rangeCells).Copy
'Now, paste to y worksheet:
y.Sheets("Jan").Range(rangeCells).PasteSpecial
Next
'Close x:
x.Close
End Sub
Note how I am reusing the copy-paste code by identifying the range address using a comma separated string in the Split statement. If, for example, you wanted to add another copy range you can just add it to the end.
For example:
' Also add A50:AX50 to the copy-paste operation.
For Each rangeCells In Split("A7:AX7,A23:AX23,A50:AX50", ",")