I was trying to copy a text file and paste the data in excel using the following code. The code works satisfactorily to the extent copying and pasting data in the destination excel sheet, but additionally, opens up another excel file and sheet with the same name as the Text file, without being prompted anywhere in the code, and pastes the data there as well. This is not desirable. I don't want to split the data to columns or perform any other actions. It is a plain and simple copy and paste task. I have searched this and various other websites for an answer but failed to get one that appropriately addresses my problem. I am unable to figure out the flaw in the code, and therefore, seek your help. Any help would be most thankfully acknowledged.
Here is my code:
Sub CopyTextFile()
Set TxtFileName = Workbooks.Open("D:\Spares\Inventory\list_of_spares.txt")
TxtFileName.Sheets(1).Range("A1").CurrentRegion.Copy
Workbooks("Macro Test.xlsm").Activate
ActiveWorkbook.Sheets(1).Range("A1").Select
ActiveSheet.Paste
End Sub
You're getting the "extra file" because you are opening the text file in Excel (with the Workbooks.Open statement) and then copying the data from it.
Instead, open the file with a filesystemobject and read the data, then write it directly into your workbook:
Sub CopyTextFile()
Dim oFso : Set oFso = CreateObject("Scripting.FileSystemObject")
Dim oFile : Set oFile = oFso.OpenTextFile("D:\Spares\Inventory\list_of_spares.txt", 1)
Dim sText
sText = oFile.ReadAll
oFile.Close
ThisWorkbook.Sheets(1).Range("A1").Value = sText
End Sub
See how that works for you?
I found a way to make your code work, you had to close the second workbook that was open, your code helped me thats why i am pointing out what was missing.
Sub CopyTextFile()
Set TxtFileName = Workbooks.Open("D:\Spares\Inventory\list_of_spares.txt")
TxtFileName.Sheets(1).Range("A1").CurrentRegion.Copy
Workbooks("Macro Test.xlsm").Activate
ActiveWorkbook.Sheets(1).Range("A1").Select
ActiveSheet.Paste
Workbooks(2).Close
End Sub
If you mention Workbooks(1).Close, it would close the first opened excel, here we want to close the second workbook hence Workbooks(2).Close
I found some excel vba code on this link which helped:https://www.excel-easy.com/vba/examples/close-open.html
Related
I have what it seems a small issue but cannot figure out how to solve.
So, every week I have to make a bunch of pivot tables to summarize raw data that I am getting. I figured, it would be much easier if I create all the tables into a Layout file and then just copy them to the new file and then change the source. And I wrote the following code:
Sub something()
Workbooks.Open Filename:="C:\\\\Layout.xlsx"
With Workbooks("Layout.xlsx")
.Sheets("Pivot").Copy Before:=ActiveWorkbook.Sheets("Main List")
.Close savechanges:=False
End With
End Sub
This code works just fine. The issue comes when I try to paste the code into my personal workbook and then run through VBA directly, rather than copying and pasting it every time.
What I could do is, to change the code from 'Activeworkbook' to the name of my new workbook but its name change every week, because it is based on a date.
I already tried to declare the name of the new workbook as a string and call it through that but that didn't work either.
Any ideas?
I would use workbook objects to keep the two files clear:
Sub something()
Dim wb_from As Workbook, wb_to As Workbook
Set wb_to = ActiveWorkbook
Workbooks.Open Filename:="C:\\\\Layout.xlsx"
Set wb_from = Workbooks("Layout.xlsx")
wb_from.Sheets("Pivot").Copy Before:=wb_to.Sheets("Main List")
wb_from.Close SaveChanges:=False
end sub
We have 2 different files with basic vlookup infos:
Source file is: JP2-CSV CRAWLER
Destination file is: JP2-CATEGORIES
We are trying to copy one full column from the Source file to the first column of the destination file automatically ( It should work when opening it or using it)
That's our code:
Sub Copysubcat()
Dim wbSource As Workbook
Dim wbDestination As Workbook
Set wbSource = Workbooks.Open( _
Filename:="C:\Users\user\Desktop\crawler file\JP2-CSV CRAWLER.xlsx")
Set wbDestination = Workbooks("C:\Users\user\Desktop\crawler file\JP2-CATEGORIES.xlsx")
wbSource.Sheets("CSV Crawler").Range("P2:P10000").Copy
wbDestination.Sheets("Cats & Subcats").Range("A2:A10000").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
ActiveWorkbook.Save
End Sub
We are having an error "Subscript out of range"
Anybody could help on that?
Workbooks isn't a method, so it cannot take any parameters. This is class, which represents workbooks, which contains methods to handle them. One of them is Open which you will need in this case. So you'll need to switch this:
Set wbDestination = Workbooks("C:\Users\user\Desktop\crawler file\JP2-CATEGORIES.xlsx")
to this:
Set wbDestination = Workbooks.Open("C:\Users\user\Desktop\crawler file\JP2-CATEGORIES.xlsx")
Also, there is an event such as opening the workbook, you can place your corrected code there, so the macro would run every time this event is raised (i.e. on every opening). If you are using standard VBA development environment in Excel, click on This_workbook on right side (in tree view), you will have to dropdown lists at the top, in the one on the left choose Workbook, in the other one select Open (this is list of events, that is raised by Workbook). Then, inside generated method place youre code :)
Good day all:
I'm trying to use a ActiveX command button to copy excel worksheets into another file. Here's the background:
I have excel log sheets that are being filled up every day. The logs have a set criterion (A, B, C, etc.) being run daily. While we still want to keep the logs in a daily file, I want a command button to be able to export to another workbook as a master file (e.g. "A_Masterfile", "B_Masterfile", etc.).
I've tried researching, but all these requirements come from different sites/pages. But since the method they use are so different, I'm having a hard time trying to get all Syntax to fit so that one code can do everything.
As a rundown, here's what I want it to do:
Export active worksheet to another workbook
a) If workbook exists, copy sheet to end of workbook
b) If workbook does not exist, create workbook and copy sheet
Destination workbook is based on a cell (criterion A, B, etc.)
Destination workbook might be in a different folder as source worksheet/workbook
Based on what I'm researching so far, this is what I'm turning up with.
When simply copying, this is what I read, but I could not get it to work.
ActiveSheet.Copy After:=Workbooks("Destination.xlsx").Worksheets(Worksheets.Count)
For Creating New File, this is what I read, but even from the original site, they said the problem was it copies the whole workbook, not just one specific sheet.
ActiveWorkbook.SaveAs "C:\path\Destination.xlsx"
Finally, I read about concatenation to create "Destination" file name based on a cell value. However, I got so lost with all the syntax. I tried simply copy pasting but I couldn't get it to work.
This is quite a bit to ask. Thanks so much in advance for all your help!
Please let me know if I can clarify anything.
P.S. Extra note: I've done some QBasic and MATLAB and a tiny bit of JAVA programming in school, so I got the logic part down. But I am quite new to VBA syntax, so extra information would be appreciated. :)
Update:
I just learned about "Record Macro" and I tried using it
I got this from it and it works:
Sheets("SourceSheet").Select
ActiveSheet.CheckBoxes.Add(639, 30, 58.8, 16.8).Select
ActiveSheet.CheckBoxes.Add(639.6, 44.4, 58.8, 16.8).Select
ActiveSheet.CheckBoxes.Add(639.6, 61.2, 58.8, 16.8).Select
ActiveSheet.OptionButtons.Add(1279.8, 37.8, 20.4, 18).Select
ActiveSheet.OptionButtons.Add(1280.4, 57, 21.6, 17.4).Select
Sheets("SourceSheet").Copy After:=Workbooks("DestinationMasterFile.xlsx").Sheets(1)
Windows("SourceWorkBook.xlsm").Activate
It works, but only put it after the first sheet instead of putting it in the end. I know it comes from the .Sheets(1), but I don't know how to write it otherwise. Thanks.
I have done a lot more research and trial and error, and I came up with a working code. This might be messy, but it works. Any further improvements are appreciated.
Private Sub CommandButton1_Click()
'Code for Locking
Sheets("W").Unprotect
Range("A1:BZ125").Locked = True
Sheets("W").Protect Password:="hello"
'Code for Copying
'Declarations
Dim Wk As Workbook
Dim FName As String
Dim FNameTwo As String
Dim FilePath As String
Dim TestStr As String
Dim wb As Workbook
'Initializing Constants
Set wb = ThisWorkbook
FName = "C:\Users\PHReyesDa\Desktop\" & Range("BO1") & ".xlsx"
FNameTwo = Range("BO1") + ".xlsx"
'If statement Setup (if exist)
FilePath = FName
TestStr = ""
On Error Resume Next
TestStr = Dir(FilePath)
On Error GoTo 0
'If statement
If TestStr = "" Then
'If not existing, create new file
MsgBox "File didn't exist yet; new file created"
Set Wk = Workbooks.Add
Application.DisplayAlerts = False
Wk.SaveAs Filename:=FName
Application.DisplayAlerts = True
Workbooks(FNameTwo).Close SaveChanges:=True
End If
'Reopens Master File
Workbooks.Open FName
wb.Activate
'Find number of worksheets in destination workbook to worksheet could be copied to end of workbook
Dim Num As Integer
Num = Workbooks(FNameTwo).Worksheets.Count
'Copy source worksheet to (the end of) destination workbook
Sheets("W").Select
Sheets("W").Copy After:=Workbooks(FNameTwo).Worksheets(Num)
'Close and save new workbook, confirmation of successful copy
Workbooks(FNameTwo).Close SaveChanges:=True
MsgBox "Worksheet successfully exported and saved to master file"
End Sub
A non-IT related class has been assigned a group project where the work they do will be stored is a single .xlsx file. The members decided the best way to collaboratively edit said file would be to split it into its constituent sheets, upload each *.xlsx sheet to an SVN repository, and use locks and a .txt file to organize sheet/member responsibility.
The group has accomplished the splitting of said files with a VB script (courtesy of this wonderful site) which was as follows:
Sub SaveSheets()
Dim strPath As String
Dim ws As Worksheet
Application.ScreenUpdating = False
strPath = ActiveWorkbook.Path & "\"
For Each ws In ThisWorkbook.Sheets
ws.Copy
'Use this line if you want to break any links:
BreakLinks Workbooks(Workbooks.Count)
Workbooks(Workbooks.Count).Close True, strPath & ws.Name & ".xlsx"
Next
Application.ScreenUpdating = True
End Sub
Sub BreakLinks(wb As Workbook)
Dim lnk As Variant
For Each lnk In wb.LinkSources(xlExcelLinks)
wb.Breaklink lnk, xlLinkTypeExcelLinks
Next
End Sub
Therewith the group now has a repository where each member is currently in the process of editing their respective files. The question then is, how can we automate the re-unification of these files into one .xlsx file with the preservation of the original links.
EDIT 4/2: started bounty // I'm aware that the links were "broken" by the above script but am not exactly sure what this means though I suspect it would make re-assembly with the preservation of original links more difficult. It should be noted that the original file which had the links is still available and might could be used to assist with this problem.
EDIT 4/2: Excel version is 2010--original links do not exist in current files.
EDIT 4/3: Original links are not in the current files, but it is desired that with the re-unification the original links (from original unedited file, pre-splitting) be re-created/preserved.
If you have SharePoint, you can all update the same Excel (2003 or 2010) book.
http://office.microsoft.com/en-us/excel-help/about-shared-workbooks-HP005262294.aspx
The links then don't really apply in the solution, as you said the original doesn't have any links and so reassembly with links isn't required.
The script provided even has a comment embedded saying "Use this line if you want to break any links:". So if you comment the line below out (prepend the line with a ') it will preserve the links in the child workbooks.
Using the answer to a previous question on copying sheets to another workbook reassembly can be accomplished with the following VBA:
Sub CombineSheets()
Dim strPath As String
Dim ws As Worksheet
Dim targetWorkbook As Workbook
Set targetWorkbook = ActiveWorkbook
Application.ScreenUpdating = False
'Adjust path location of split files
strPath = "C:\code\xls-split"
Dim str As String
'This can be adjusted to suit a filename pattern.
str = Dir(strPath & "\*.xl*")
Do Until str = ""
'Open Workbook x and Set a Workbook variable to it
Set wbResults = Workbooks.Open(strPath & "\" & str, UpdateLinks:=0)
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=targetWorkbook.Sheets(targetWorkbook.Sheets.Count)
Next Sheet
wbResults.Close SaveChanges:=False
str = Dir()
Loop
Application.ScreenUpdating = True
End Sub
This will append the other workbooks to the currently opened workbook.
Sourced Replacing FileSearch function for code to find xls files in a directory.
We probably need more detail in order to help you, but you may be able to accomplish what you need as follows (maybe this can kick-start a solution):
Loop through the sheets in the workbook
For each sheet
Open the appropriate xlsx file
Identify non-formula cells
For each of those cells
Copy to the identical location in the main workbook
Close the xlsx file
Below is an example (based on your SaveSheets code). If you try this, be sure to backup everything first. We obviously don’t know how the spreadsheets are laid out and how they are used. It would really suck if it got all screwed up. Also, there are some assumptions:
The layout and used range in the xlsx files are the exact same layout and used range as it appears in the original workbook.
The links you are referring to are formulas (either to another sheet or another workbook).
If these assumptions are wrong, you will need to modify as appropriate (identifying specific ranges to copy and/or adding more robust logic to the routine).
Note that the actual code to do this is very short. I added comments and basic error handling which significantly increased the amount of code.
This code would be added to the original workbook.
Sub RetrieveSheets()
Dim strPath As String
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim wbk As Workbook
Dim rng As Range
Application.ScreenUpdating = False
strPath = ActiveWorkbook.Path & "\"
For Each ws In ThisWorkbook.Sheets
'Open the xlsx file (read only)
Set wbk = Nothing
On Error Resume Next
Set wbk = Workbooks.Open(strPath & ws.Name & ".xlsx", ReadOnly:=True)
On Error GoTo 0
'Continue if xlsx file was successfully opened
If Not wbk Is Nothing Then
Set ws2 = Nothing
On Error Resume Next
Set ws2 = wbk.Worksheets(ws.Name)
On Error GoTo 0
'Continue if appropriate sheet was found
If Not ws2 Is Nothing Then
'Identify cells to copy over (cells that are constants)
For Each rng In ws2.Cells.SpecialCells(xlCellTypeConstants)
'set the cell value equal to the identical cell location in the xlsx file
If (Left(ws.Range(rng.Address).Formula, 1)) <> "=" Then
ws.Range(rng.Address) = rng
End If
Next
Set ws2 = Nothing
End If
'Close the xlsx file
wbk.Close False
End If
Next
Set wbk = Nothing
Application.ScreenUpdating = True
End Sub
This is a rough outline of how I accomplished this:
Use Office2013 and not office 2010
create tmp/ directory with original .xlsx assignment file.
create source/ directory in tmp/
use split sheets module (listed on this page), but comment out the line that break links.
place all of the resulting .xlsx files into source/ (you can delete the original .xlsx file)
remote the first sheet from the sources/ folder, and place it ../
Open this first sheet, and import/use the 'combinesheets' module listed on this page.
Save the sheet, reopen it and you'll be prompted to update links. Do so, and select "change source" and select the first sheet Re in step 6.
links will automatically update; done.
Notes: you'll have to save a file as macro enabled, ...
Take a look at this MSDN Article on Merging Data from multiple workbook (.xls/.xlsx) files
http://msdn.microsoft.com/en-us/library/office/gg549168%28v=office.14%29.aspx
I don't know much about VBA but I think this is what you are looking for.
Also note it does get rid of the need for a text file to manage the files
I have an Excel workbook, which using VBA code that opens another workbook, copies some data into the original, then closes the second workbook.
When I close the second workbook (using Application.Close), I get a prompt for:
Do you want to save the clipboard.
Is there a command in VBA which will bypass this prompt?
I can offer two options
Direct copy
Based on your description I'm guessing you are doing something like
Set wb2 = Application.Workbooks.Open("YourFile.xls")
wb2.Sheets("YourSheet").[<YourRange>].Copy
ThisWorkbook.Sheets("SomeSheet").Paste
wb2.close
If this is the case, you don't need to copy via the clipboard. This method copies from source to destination directly. No data in clipboard = no prompt
Set wb2 = Application.Workbooks.Open("YourFile.xls")
wb2.Sheets("YourSheet").[<YourRange>].Copy ThisWorkbook.Sheets("SomeSheet").Cells(<YourCell")
wb2.close
Suppress prompt
You can prevent all alert pop-ups by setting
Application.DisplayAlerts = False
[Edit]
To copy values only: don't use copy/paste at all
Dim rSrc As Range
Dim rDst As Range
Set rSrc = wb2.Sheets("YourSheet").Range("YourRange")
Set rDst = ThisWorkbook.Sheets("SomeSheet").Cells("YourCell").Resize(rSrc.Rows.Count, rSrc.Columns.Count)
rDst = rSrc.Value
If I may add one more solution: you can simply cancel the clipboard with this command:
Application.CutCopyMode = False
I have hit this problem in the past - from the look of it if you don't actually need the clipboard at the point that you exit, so you can use the same simple solution I had. Just clear the clipboard. :)
ActiveCell.Copy
If you don't want to save any changes and don't want that Save prompt while saving an Excel file using Macro then this piece of code may helpful for you
Sub Auto_Close()
ThisWorkbook.Saved = True
End Sub
Because the Saved property is set to True, Excel responds as though the workbook has already been saved and no changes have occurred since that last save, so no Save prompt.
There is a simple work around. The alert only comes up when you have a large amount of data in your clipboard. Just copy a random cell before you close the workbook and it won't show up anymore!
Just clear the clipboard before closing.
Application.CutCopyMode=False
ActiveWindow.Close
proposed solution edit works if you replace the row
Set rDst = ThisWorkbook.Sheets("SomeSheet").Cells("YourCell").Resize(rSrc.Rows.Count, rSrc.Columns.Count)
with
Set rDst = ThisWorkbook.Sheets("SomeSheet").Range("YourRange").Resize(rSrc.Rows.Count, rSrc.Columns.Count)