I have an Excel 2007 document with multiple sheets, let's call it source.xls. I'd like to copy some of the sheets into all Excel documents within a folder, say C:\some_folder.
I figured how to loop over a directory:
Dim file As String
file = dir("C:\some_folder\*.xlsx")
Do While file <> ""
Rem do_stuff
file = dir()
Loop
And how to copy sheets between workbooks:
For Each ws in ActiveWorkbook.Worksheets
Dim wb as Workbook
Set wb = Workbook.Open(file)
ws.Copy , wb.sheets(w.sheets.Count)
wb.Close SaveChanges:=True
Next ws
So far so good.
Now one of the sheets contains a table with external data from an SQL Server. Copying it works well.
Another sheet references data in that table as Table_MYSERVER_MYDB[[row][col]]. When I copy it, the references are automatically turned into source.xls!Table_MYSERVER_MYDB[[row][col]]
UPDATE:
I just tried to reference the data in the table by sheet and cell, e.g. =Other_Sheet!A1. Still the same problem, the reference magically turns into =[source.xls]Other_Sheet!A1.
UPDATE 2:
The next try was to access the cells in the other sheet with =INDIRECT("Other_Sheet!"&CELL("address")), but that seems to trigger a bug in Excel 2007. All cells will show the same value. Try it for yourself :)
I'd like the sheets in the target document to reference the table in the same workbook. How would I do that?
I'm open for other solutions than VBA too
I just figured it out myself:
My last desperate attempt was using Search&Replace over all formulas to remove [source.xls].
That's when a workmate suggested using:
wb.ChangeLink Name:=source.xls NewName:=wb.Name Type:=xlExcelLinks
Exactly what I was looking for!
Try this:
Sub CopyFormula()
Dim R1,R2 As Range
Set R1 = Workbooks("wb2.xls").Sheets(1).Range("A1")
Set R2 = Workbooks("wb1.xls").Sheets(1).Range("A1")
R1.Formula = R2.Formula
End Sub
Related
I have a simple problem(at least seems to be) that I just cannot seem to be able to find a good solution to:
I have 4 workbooks, that all contain two of the exact worksheets(rest of the worksheets are unique for each workbook). I am storing these two worksheets in a seperate workbook(so 5th workbook). Out of these 2 worksheets, 1 of them is a Data sheet made up of many tables, which I do updates on and the other one is a sheet called V, which just uses some vlookup functions to bring up the related data from this Data sheet.
I am trying to find a way to be able to pass along this data sheet to each individual workbook, instead of editing the data sheet individually for each workbook(All 4 of them).
I was able to come up with the following macro, which checks if the sheet already exists and if it does it deletes it. Then it opens up location of the excel file, copies this worksheet to the workbook and therefore I have the most "updated" version of this data worksheet.
Sub UpdateT()
Sheets("data").Visible = True
Dim wb As Workbook
Dim aw As Workbook
''Open 2nd Workbook
Set aw = Application.ActiveWorkbook
'Check if data worksheet exists, and if it does delete it
If Not GetWorksheet("data") Is Nothing Then
Application.DisplayAlerts = False
Worksheets("data").Delete
Application.DisplayAlerts = True
End If
'Check if T worksheet exists, and if it does, delete it
If Not GetWorksheet("T") Is Nothing Then
Application.DisplayAlerts = False
Worksheets("T").Delete
Application.DisplayAlerts = True
End If
Set wb = Workbooks.Open(Filename:="C:\Users\yilmadu001\Desktop\Update.xlsx")
'Copy To Different Workbook
wb.Sheets("data").Copy _
After:=aw.Sheets("Data1")
wb.Sheets("5120 TI").Copy _
After:=aw.Sheets("MENU5120")
'Close 2nd Workbook
aw.Save
wb.Close
'Hide the data worksheet
aw.Sheets("data").Visible = False
End Sub
'Function to check if worksheets exist
Function GetWorksheet(shtName As String) As Worksheet
On Error Resume Next
Set GetWorksheet = Worksheets(shtName)
End Function
The problem is the following:
When the new Data worksheet is transferred, the V worksheet is no longer working with the Vlookup function to be able to point to the relative information. So then I thought, okay what if I transfer BOTH Data and V worksheets, however that also did not work.
Is there a way to be able to use Vlookup, while copying the Data sheet? (The name is exactly the same I do not understand why it does not seem to be able to point to the cells of the table). It just looks blank, can't point to anything.
NOTE: I am not changing the format of the Data tables, basically just the values, so the format is the exactly the same.
It is probably important to note that the main excel workbooks(the 4) are in use 24/7, therefore I cannot go the other way(Update from Data workbook to the main workbook). I must "pull" the updated worksheet rather than "push".
If anyone has any suggestions I'd really appreciate. Thank you.
I am trying to select copy everything from a "database" workbook. and paste it in the current workbook, sheet 5. The code I am using is the following.
Sub Import()
Dim DBaseWB As Workbook
Set DBaseWB = Workbooks.Open("http://collaboration.pwc.ca/team/Plant5EngineLines/Documents/Plant 5 master build plan/Database.xlsm", UpdateLinks:=False)
' set DBaseWB as the database workbook after opening it from sharepoint.
Dim DBaseSheet As Worksheet
Set DBaseSheet = DBaseWB.Sheets(1) 'DBaseSheet is referenced to sheet 1 of Database workbook.
Sheet5.Cells.Clear
DBaseSheet.UsedRange.Copy 'Copy everything from the database
Sheet5.Range("A1").PasteSpecial xlPasteAll 'Paste everything in sheet 5 of current workbook
Application.DisplayAlerts = False
DBaseWB.Close saveChanges:=False
Application.DisplayAlerts = True
End Sub
I am receiving an error when running the following code. Though, sometimes it doesn't give me an error.
Run-time error '1004': PasteSpecial method of Range class failed
I think I know why it's giving me an error at the PasteSpecial line. When I have a different cell selected in sheet 5, it gives me no error. but when I recheck, without selecting any other cell, (so it will have the pasted range selected), I get this error.
I tried using the following line between copy and pastespecial,
Sheet5.range("A1").select
it gives me the same error.
----------UPDATE----------
I first used DisplayName's solution and it worked until yesterday. But this morning, it was causing problems. It another error. Then I tried all other solutions with no luck. all gave me the same errors. I also added the workbook.worksheet to the solutions below giving me no luck. This time the error was with the copy method. I also noticed that lots of columns say #REF.
Versions I tried:
DisplayName's solution combined with thisworkbook.worksheet
Sheet5.UsedRange.Clear
With Workbooks.Open("http://collaboration.pwc.ca/team/Plant5EngineLines/Documents/Plant 5 master build plan/Database.xlsm", UpdateLinks:=False) 'open and reference your Database workbook
.Sheets(1).UsedRange.Copy Destination:=ThisWorkbook.Sheets(5).Range("A1") ' copy referenced workbook sheet 1 content and paste it to sheet 5
.Close False
End With
Gary's Student's solution combined with thisworkbook.worksheet
Dim DBaseWB As Workbook
Set DBaseWB = Workbooks.Open("http://collaboration.pwc.ca/team/Plant5EngineLines/Documents/Plant 5 master build plan/Database.xlsm", UpdateLinks:=False)
' set DBaseWB as the database workbook after opening it from sharepoint.
Dim DBaseSheet As Worksheet
Set DBaseSheet = DBaseWB.Sheets(1) 'DBaseSheet is referenced to sheet 1 of Database workbook.
Dim Destination As Worksheet
Set DestinSh = ThisWorkbook.Sheets(5)
Sheet5.Cells.Clear
DBaseSheet.UsedRange.Copy DestinSh.Range("A1").PasteSpecial 'copy database info in planning tool.
Application.DisplayAlerts = False
DBaseWB.Close saveChanges:=False
Application.DisplayAlerts = True
errors:
Run-time error '1004': Copy method of Range class failed
First insure that there are no merged cells on either worksheet, and then try:
DBaseSheet.UsedRange.Copy Sheet5.Range("A1")
you could simply go:
Sub Import()
Sheet5.UsedRange.Clear
With Workbooks.Open("http://collaboration.pwc.ca/team/Plant5EngineLines/Documents/Plant 5 master build plan/Database.xlsm", UpdateLinks:=False) 'open and reference your Database workbook
.Sheets(1).UsedRange.Copy Destination:=Sheet5.Range("A1") ' copy referenced workbook sheet 1 content and paste it to sheet 5
.Close False
End With
End Sub
I am with Bruce Wayne on this one
As you have opened a new workbook the focus is now on that workbook.
If you are trying to clear the cells in the workbook the code resides in (destination) after you have launched a new workbook and switched the focus you will need to reference the original workbook to do so, like this:
ThisWorkbook.Sheets(5).Cells.Clear
Hope this helps
I'm very new to VBA macros and have taught myself some code but I'm struggling with my current piece of work and can't find the answer I am looking for.
I want to copy a range of cells (B3:N21) from one workbook to another "master" workbook - which seems simple enough - but I would like it to copy into a blank/new worksheet in the Master copy every time the Macro is run.
The range contains formulas, I would only need the values copied to the Master workbook.
Any help with this would be greatly appreciated.
Thanks
Worksheets("Sheet1").Range("C1:C5").Copy
Worksheets("Sheet2").activate
Worksheets("Sheet2").Range("D1:D5").PasteSpecial _
Operation:=xlPasteSpecialOperationAdd
End With
I think you only need paste special, this is an example
try this
Option Explicit
Sub main()
Dim masterWb As Workbook
Dim mySht As Worksheet
Set mySht = ThisWorkbook.ActiveSheet '<~~ assuming you're copying values from active worksheet of the workbook the macro resides in
' beware: if you start the macro while the active sheet is not the one you want, this will lead to unespected results
Set masterWb = Workbooks("Master") '<~~ Change "Master" with whatever name your master workbook must have
' beware: we're assuming "Master" workbook is already open, otherwise this line will throw an error
With masterWb.Worksheets.Add
.Range("B3:N21").Value = mySht.Range("B3:N21").Value
End With
End Sub
mind the comments
the code above can be reduce to a much less verbose (and self explanatory, too) one like follows
Sub main2()
Workbooks("Master").Worksheets.Add.Range("B3:N21").Value = ThisWorkbook.ActiveSheet.Range("B3:N21").Value
End Sub
where apply the same comments of the lengthy code, which is:
assuming you're copying values from active worksheet of the workbook the macro resides in
beware: if you start the macro while the active sheet is not the one you want, this will lead to unespected results
change "Master" with whatever name your master workbook must have
beware: we're assuming "Master" workbook is already open, otherwise an error would be thrown
Im trying to open and copy the cells from a sheet from a different excel file. I have no problem in opening, copying and closing the excel file that I need.In this case, I have With x.Sheets("Documents").UsedRange. Most files that I needed to copy the cells from have "Documents" as a sheet name, but some have "Documents" + other different characters (example, "DocuemntsEX"). When I tried to copy, it shows 'Subscript Out-of-range' since the "DocumentEX" is different from "Document". Is there any way that I can retain the specific name of the sheet, since most of the files have that name? Is there any code that can help me to access those sheet with a different sheetname? Just hit me up if you need clarifications.
Use a wildcard character to get the sheet first:
Function GetDocumentSheet(ByRef wb As Workbook) As Worksheet
For Each ws In wb.Sheets
If LCase$(ws.Name) Like "documents*" Then
Set GetDocumentSheet = ws
GoTo SheetFound:
End If
Next
Set GetDocumentSheet = Nothing
SheetFound:
End Function
In your code:
Set mySheet = GetDocumentSheet(x) '// where 'x' is your workbook object
Then reference
mySheet.UsedRange
As i said in comment, you can use sheets by number, or you can use something like this
Sub findSheet()
Dim sheetSubName As String
sheetSubName = "fluff"
Dim currentSheet As Worksheet
For Each currentSheet In Sheets
If currentSheet.Name Like sheetSubName & "*" Then
MsgBox "do some stuff"
End If
Next currentSheet
End Sub
When you comparing sheet name to string and regular character (in my example * so its anything). So this macro will work with sheet fluff, fluffy fluffiest etc.
And everything to looping via Sheets (all sheet in workbook) and comparing their names via Like (something like = ) but it can use some basic regular expression.
Private Sub CommandButton1_Click()
Dim ws As Worksheet
With Application.FileDialog(msoFileDialogFilePicker)
.Show
If .SelectedItems.Count <> 0 Then
fldr = .SelectedItems(1)
End If
End With
Sheets.link.Value = fldr
For i = 1 To Worksheets.Count
Set ws = Worksheets(i)
If ws.Cells(2, 1) = "X" Then
Sheets.ComboBox1.AddItem (ws.Name)
End If
Next i
Workbooks.Open (fldr)
Sheets.Show
End Sub
Private Sub Add_Click()
Dim x As String
Dim ws As Workbook
x = Right(link.Value, (Len(link.Value) - InStrRev(link.Value, "ild") - 3))
Workbooks("Test.xlsm").Activate
Worksheets(ComboBox1.Value).Copy Before:=Workbooks(x).Worksheets("Contract")
End Sub
So the basic idea is, you click a button on an Excel sheet. The user then finds the file they want to copy the sheets to. It will find all of a specific type of sheet, put it in a forms combobox and open the selected Excel file.
Then you choose a sheet from the combobox and copy it from one workbook to the other. It all works until the copying part. I get a long error:
Excel cannot insert the sheets into the destination workbook, because it contains fewer rows and columns that the source workbook. To move or copy the data to the destination workbook, you can select the data and then use Copy and Paste commands to insert it into the sheets of another workbook.
If the destination workbook comes from an older version of Excel (extension .xls for instance, Excel 97 or Excel 2003), the limit of number of rows in old worksheets is 2^16-1, as the row number is encoded on 16 bits. In newer versions, this number is encoded on 32 bits.
Hence, copying a worksheet "as a whole" from a newer version into a workbook from an older version raises this error. From my test, this error occurs even if the actually used range in the copied worksheet is small.
I had this same problem.
Following #A.S.G. suggestion, I saved the old workbook with the new file format (xlsx), closed and reopened it and everything worked fine afterwards.
Hope it helps.