I have a range in excel lets say A1:A50, and every cells contain hyperlink. I sort the range and get the only cells that needed..
Is there any ways using VBA, to save files in the hyperlink from the sorted cells to other folder?
The source link is from computer, not from internet URL.
thanks in advance.
Ciao
Below is the code
, I got this type of error when run it
Run time error '1004':
Sorry, we couldn't find (file name).pdf. Is it possible it was moved, renamed, or deleted?
Sub download ()
Dim linkfile As hyperlink
Dim wb as workbook
Dim savelocation As string
savelocation = "C:\(folder name)"
For Each linkfile In Thisworkbook.Sheets("sheet name").Hyperlinks
Set wb = Workbooks.Open(linkfile.address)
wb.Saveas savelocation & linkfile.Parent & ".pdf"
wb.Close True
Set wb = nothing
Next
End Sub
Related
I'm trying to implement a simple Excel-VBA Macro to have the user browse for another workbook in the file explorer, and then have certain cells in that workbook copied into my active workbook. Here's my short code:
Sub Load_AutoCADBOM()
Dim wbk As Workbook
Dim MyFile As String
MyFile = Application.GetOpenFilename()
If MyFile <> "False" Then
Set wbk = Workbooks.Open(MyFile)
With wbk.Sheets(1)
Range("B2:C43").Copy
End With
ActiveWorkbook.Close
With ThisWorkbook.Worksheets("Config")
Range("A6:B47").PasteSpecial Paste:=xlPasteValues
End With
End If
End Sub
The macro is meant to copy cells from (B2:C43) from the selected workbook and copy them into cells (A6:B47) on sheet "Config" of my current workbook. When I run the macro I get "Run-time error '1004': PasteSpecial method of Range class failed." The debugger highlights the line:
Range("A6:B47").PasteSpecial Paste:=xlPasteValues
I've tried copying from csv, xls & xlsm files all with the same result. Could it possibly be the way my cells are formatted in the sheet I'm pasting to? The funny this is I've used this macro in another workbook and had it work no problem.
If anyone knows of any way I can fix my code and get it working, it would be much appreciated.
Thankyou
End Sub
If you just want to copy values then you can skip the copy/paste and set the values directly from the source range:
Sub Load_AutoCADBOM()
Dim wbk As Workbook
Dim MyFile As String
MyFile = Application.GetOpenFilename()
If MyFile <> "False" Then
Set wbk = Workbooks.Open(MyFile)
With wbk.Sheets(1).Range("B2:C43")
ThisWorkbook.Worksheets("Config").Range("A6").Resize(.rows.count, .columns.count).value = .Value
End With
wbk.Close
End If
End Sub
I want to copy a range of cells in my .csv file into a template.csv (named "pp"). Then I would like to save the template as "name of the original .csv file_2", without closing the original template as I would need it to do this procedure in loop for all the files in my folder. I have come up with this code that doesn't work:
Sub LoopThroughDirectory()
Dim MyFile As String
Dim pp As Workbook ' Workbook to receive the copied data
Dim ppSht As Worksheet ' Worksheet where copied data will be inserted
Dim Wkb As Workbook ' Temporary workbook for the Loop
Dim Sht As Worksheet ' Temporary worksheet variable for the loop
MyFile = Dir("R:\COMT study\Silvia\Cognitive data\COMT 1\Tasks\CPT*.csv*")
Set pp = Workbooks("pp.csv")
Set ppSht = pp.Sheets("Sheet1")
Do While MyFile <> ""
Set Wkb = Workbook.Open("R:\COMT study\Silvia\Cognitive data\COMT 1\Tasks\CPT" & MyFile)
Set Sht = Wkb.Worksheets("sheet1")
Sht.Range("A1:G113").Copy
With ppSht
.Range("A1:G113").PasteSpecial xlPasteFormulas
End With
pp.SaveCopyAs Filename = MyFile_2.csv
Wkb.Close True
MyFile = Dir
Loop
End Sub
I am new to the vba coding and I am not sure what I am doing wrong as I don't get any error messages, the code simply doesn't run. Do you have any suggestion?
First of all I would like to recommend you how to use a CSV file (Comma-separated values). By this a csv file does not have any sheets. Therefore you can reach the worksheet with the following, there wb is the workbook. Another good advice is to use Option Explicit that enables some error codes, example if you get to initialize a variable.
Dim pp As Workbook
pp.Worksheets (1)
Do While MyFile <> ""
Set wb = Workbooks.Open("R:\COMT study\Silvia\Cognitive data\COMT 1\Tasks\CPT" & MyFile)
With wb.Worksheets(1)
Range(A1,G113).copy
End With
With ppSht
.Range(A1,G113).PasteSpecial xlPasteFormulas
End With
pp.SaveCopyAs Filename = "MyFile_2.csv"
'Remove the wb.Close if you want the sheet to stay open (Not recommended if there are many files)
wb.Close
MyFile = Dir
loop
Try using some of this (Haven't tried it so just use it as a template). See if you can get any errors or at least if you can collect the data from the file into a array.
I have a workbook containing one worksheet ("DB Output" or Sheet 34) which I would like to copy to several (around 45) files in within the same folder.
None of the target files have an existing sheet named "DB Output" - the objective is to find a way to insert a copy of this sheet, forumlas and all, into each one.
The range of cells on that sheet that needs to be copied to a sheet of the same name in each book is A1:PE5
The sheet contains references to cells in the book it is currently in, however as the files which I am seeking to copy the worksheet to all share the same template, I want the references to be to the local file, not the original one.
I've tried looking at RDBMerge, however it seems that is for merging sheets, and while I do want to do that, it will not help me do it multiple times quickly.
Likewise I have looked on SO for similar situations, this is the closest, however my attempts to adapt that code have failed as I only have a single workskeet. Never the less, as it is always useful to inlcude what you have already tried, here is my existing attempt:
Option Explicit
Public Sub splitsheets()
Dim srcwb As Workbook, trgwb As Workbook
Dim ws As Worksheet, t1ws As Worksheet
Dim rng1 As Range
Dim trgnm As String
Dim fpath As String
Application.ScreenUpdating = False
'--> Set this to the location of the target workbooks
fpath = "C:/file/path/"
Set srcwb = ThisWorkbook
For Each ws In srcwb.Worksheets
trgnm = ws.Name
'--> Change A1:B3 to the range to be copied to inside page
Set rng1 = srcwb.Sheets(trgnm).Range("A1:PE5")
Set trgwb = Workbooks.Open(fpath & trgnm & ".xlsm")
With trgwb
Set t1ws = .Sheets("DB Output")
End With
'--> Change A1:B3 to the range where you want to paste
rng1.Copy t1ws.Range("A1:PE5")
trgwb.Close True
Next
Application.ScreenUpdating = True
End Sub
However this starts with the first sheet in the workbook that contains DB Output (the sheet to be copied) and gives an error that "NameOfSheet1.xlsm" does not exist in that directory (which it does not).
Any help is much appreciated.
This should copy from the active workbook to all files in a directory. If you need help modifying it to fit your specific use let me know!
Edit: fixed code to only copy A1:PE5 and save each workbook.
Sub Example()
Dim path As String
Dim file As String
Dim wkbk As Workbook
path = "C:\Test\"
file = Dir(path)
Application.DisplayAlerts = False
Do While Not file = ""
Workbooks.Open (path & file)
Set wkbk = ActiveWorkbook
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "DB Output"
ThisWorkbook.Sheets("DB Output").Range("A1:PE5").Copy Destination:=wkbk.Sheets("DB Output").Range("A1")
wkbk.Save
wkbk.Close
file = Dir
Loop
Application.DisplayAlerts = True
End Sub
Please note that I did not add error handling so this could break if the active workbook is included in the directory you are trying to copy or if a sheet with the same name already exists in the workbook. If this is an issue let me know and I will add error handling.
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 macro saved in a blank workbook and multiple data workbooks.
I currently open the macro file and each data file individually, running the macro on each one with a keyboard shortcut.
Is there a way to run the macro on all the data workbooks without opening them, either with
a batch file,
VBA/VBScript,
powershell,
or something similar?
One way to do this is to add your macro's to the file PERSONAL.XLSB. This file will be loaded in the background every time you start Excel. Initially the PERSONAL.XLSB file will NOT be there.
To automatically create this file, just start recording a "dummy" macro (with the record button on the left-bottom of a spreadsheet) and select "Personal Macro Workbook" to store it in. After recording your macro, you can open the VBA editor with [Alt]+[F10] and you will see the PERSONAL.XLSB file with the "dummy" macro.
I use this file to store loads of general macro's which are always available. I have added these macro's to my own menu ribbon.
One disadvantage of this common macro file is that if you launch more than one instance of Excel, you will get an error message that the PERSONAL.XLSB file is already in use by Excel instance Nr. 1. This is no problem as long as you do not add new macro's at this moment.
Two potential solutions below,
vbscript which can be run directly as a vbs file
A vba solution to be run from within Excel (as per Tim Williams suggestion)
vbscript solution
Dim objFSO
Dim objFolder
Dim objFil
Dim objXl
Dim objWb
Dim objExcel
Set objExcel = CreateObject("Excel.Application")
Set objFSO = CreateObject("scripting.filesystemobject")
Set objFolder = objFSO.getfolder("c:\temp")
For Each objFil In objFolder.Files
If InStr(objFil.Type, "Excel") > 0 Then
Set Wb = objExcel.Workbooks.Open(objFil.Path)
wscript.echo Wb.name
Wb.Close False
End If
Next
vba solution
Sub OpenFilesVBA()
Dim Wb As Workbook
Dim strFolder As String
Dim strFil As String
strFolder = "c:\Temp"
strFil = Dir(strFolder & "\*.xls*")
Do While strFil <> vbNullString
Set Wb = Workbooks.Open(strFolder & "\" & strFil)
Wb.Close False
strFil = Dir
Loop
End Sub
I sort of stumbled across your post just now, maybe very late, but for all future searches.
It is possible to launch your Macro by creating a .vbs file.
To do this, open notepad and add the following:
objExcel = CreateObject("Excel.Application")
objExcel.Application.Run <insert macro workbook file path, module and macro name here>
objExcel.DisplayAlerts = False
objExcel.Application.Save
objExcel.Application.Quit
Set objExcel = Nothing
save the file as follows ("your filename".vbs)
By double clicking (opening) the saved .vbs file, it will launch your macro without you having to open your excel file at all.
Hope this helps.
You could keep the macro in your personal.xls, or a masterfile, and loop through the workbooks with vba, and activate them before running your macro. As far as I know, you still have to open them with vba though.
You could use something like this:
sub LoopFiles
Dim sFiles(1 to 10) as string 'You could also read this from a range in a masterfile
sFiles(1) = "Filename1.xls"
.
.
sFiles(10) = "Filename10.xls"
Dim wb as Workbook
Dim iCount as integer
iCount = ubound(sFiles)
Dim iCount2 as integer
For iCount2 = 1 to iCount
Workbooks(sFiles(iCount2)).open
Workbooks(sFiles(iCount2)).activate
Call YourMacro
Workbooks(sFiles(iCount2)).close
next iCount2
end sub
Other way,
Sub LoopAllWorkbooksOpened()
Dim wb As Workbook
For Each wb In Application.Workbooks
Call YourMacroWithWorkbookParam(wb)
Next wb
End Sub
Sub YourMacroWithWorkbookParam(wb As Workbook)
MsgBox wb.FullName
End Sub