| Home |
| Search |
| Today's Posts |
|
|
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro Saving
Hello all. So this is what I'm trying to do. I have an excel
spreadsheet that I export from a program, creating a text file. This file I have to open in excel, and then copy and paste sections into a worksheet that contains three sheets. In this second spreadsheet, there is a macro that runs certain checks and then makes the file into an XML. What I am attempting to do is create a macro that will look in a folder on my desktop that contains around 10 of these exported text files, run it through the copy and paste macro that i have created, and then run the macro in the second spreadsheet. I would then like to save both the second spreadsheet I've pasted on and the XML file. So what I have done so far is listed below. I managed to make a window pop up to select the files i want to run through the macro. What I would actually prefer to do is just look in a folder and run ALL files in there that are excel spreadsheets. I then run the copy paste macro and select the XML macro to run and then things just sort of stop. As i run the macro, it stops to prompt me to name the XML file. What I would love to do (and have attempted) is to name the file automatically a cell from the Second Workbook. I cant figure out how to get around this propmt and name it automatically. I would really appreciate if someone would look at what I've done. Im really new at this and im sure theres alot of cleaning up to do. I may have made this way more complicated then it needs to be. Thanks in advance for your help! Sub CopyPaste2() Application.ScreenUpdating = False Dim wbCurrent As Workbook files_to_open = _ Application.GetOpenFilename("Excel files (*.xls), _*.xls", , , , True) If Not IsArray(files_to_open) Then MsgBox "Nothing selected" Exit Sub Else For i = LBound(files_to_open) To UBound(files_to_open) Set wbCurrent = Workbooks.Open(files_to_open(i)) Application.StatusBar = "Processing " & files_to_open(i) FinalCopy wbCurrent FinalCopy(myWB As Workbook) Range("B18").Select Application.CutCopyMode = False Selection.Cut Destination:=Range("C18") Range("B28").Select Selection.Cut Destination:=Range("C28") Range("D18").Select ActiveCell.FormulaR1C1 = "=CLEAN(RC[-1])" Range("D28").Select ActiveCell.FormulaR1C1 = "=CLEAN(RC[-1])" Range("D18").Select Selection.Copy Range("B18").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("D28").Select Application.CutCopyMode = False Selection.Copy Range("B28").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Rows("1:1").Select Selection.Delete Shift:=xlUp ChDir "C:\Documents and Settings\Owner\Desktop" Workbooks.Open Filename:= _ "C:\Documents and Settings\Owner\Desktop\Second Worksheet.xls" ActiveWindow.ScrollWorkbookTabs Position:=xlFirst ActiveWindow.ScrollWorkbookTabs Position:=xlFirst Sheets("Demographic Info").Select ActiveWindow.ScrollRow = 12 ActiveWindow.ScrollRow = 11 ActiveWindow.ScrollRow = 10 ActiveWindow.ScrollRow = 9 ActiveWindow.ScrollRow = 8 ActiveWindow.ScrollRow = 7 ActiveWindow.ScrollRow = 6 ActiveWindow.ScrollRow = 5 ActiveWindow.ScrollRow = 4 ActiveWindow.ScrollRow = 3 ActiveWindow.ScrollRow = 2 ActiveWindow.ScrollRow = 1 myWB.Activate Range("B1:B5").Select Selection.Copy Windows("Second Worksheet.xls").Activate Range("B2").Select ActiveSheet.Paste myWB.Activate Range("B8:B19").Select Application.CutCopyMode = False Selection.Copy Windows("Second Worksheet.xls").Activate Range("B10").Select ActiveSheet.Paste myWB.Activate ActiveWindow.SmallScroll Down:=18 Range("B23:B30").Select Application.CutCopyMode = False Selection.Copy Windows("Second Worksheet").Activate Range("B25").Select ActiveSheet.Paste ActiveWindow.ScrollRow = 2 ActiveWindow.ScrollRow = 3 ActiveWindow.ScrollRow = 4 ActiveWindow.ScrollRow = 5 ActiveWindow.ScrollRow = 6 ActiveWindow.ScrollRow = 7 ActiveWindow.ScrollRow = 8 ActiveWindow.ScrollRow = 9 ActiveWindow.ScrollRow = 10 ActiveWindow.ScrollRow = 11 ActiveWindow.ScrollRow = 12 Sheets("Sheet 2").Select myWB.Activate Range("B34:B44").Select Application.CutCopyMode = False Selection.Copy Windows("Second Worksheet.xls").Activate Range("B3").Select ActiveSheet.Paste myWB.Activate ActiveWindow.SmallScroll Down:=12 Range("B49:H49").Select Application.CutCopyMode = False Selection.Copy Windows("Second Worksheet.xls").Activate Range("A18").Select ActiveSheet.Paste Sheets("Sheet 3").Select myWB.Activate Rows("51:170").Select Application.CutCopyMode = False Selection.Sort Key1:=Range("A51"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A51:O86").Select Selection.Copy Windows("Second Worksheet.xls").Activate Range("A5").Select ActiveSheet.Paste myWB.Activate Range("B49").Select Selection.Copy Windows("Second Worksheet.xls").Activate ActiveWindow.SmallScroll ToRight:=4 Sheets("Sheet 3").Select ActiveWindow.SmallScroll ToRight:=3 Application.Run "MakeXML" NewFilename = Left(files_to_open(i), Len(files_to_open(i)) - 4) _ & " - Testing - please delete.xls" wbCurrent.SaveAs NewFilename wbCurrent.Close Next i End If Set wbCurrent = Nothing Application.StatusBar = False Application.ScreenUpdating = True MsgBox UBound(files_to_open) - LBound(files_to_open) + _ 1 & " files processed (hopefully)." End Function Const fPath As String = "C:\Documents and Settings\Desktop\" Dim fName As String Dim myFileName As String myFileName = "EXCEL" & Sheets("Sheet 2").Range("A18") & ".xls" fName = fPath & myFileName ActiveSheet.SaveAs Filename = fName MsgBox "File Saved to " & fName End Function THANKS! |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Macro Saving
http://www.cpearson.com/excel/newposte.htm wrote in message Hello all. So this is what I'm trying to do. I have an excel spreadsheet that I export from a program, creating a text file. This file I have to open in excel, and then copy and paste sections into a worksheet that contains three sheets. In this second spreadsheet, there is a macro that runs certain checks and then makes the file into an XML. What I am attempting to do is create a macro that will look in a folder on my desktop that contains around 10 of these exported text files, run it through the copy and paste macro that i have created, and then run the macro in the second spreadsheet. I would then like to save both the second spreadsheet I've pasted on and the XML file. So what I have done so far is listed below. I managed to make a window pop up to select the files i want to run through the macro. What I would actually prefer to do is just look in a folder and run ALL files in there that are excel spreadsheets. I then run the copy paste macro and select the XML macro to run and then things just sort of stop. As i run the macro, it stops to prompt me to name the XML file. What I would love to do (and have attempted) is to name the file automatically a cell from the Second Workbook. I cant figure out how to get around this propmt and name it automatically. I would really appreciate if someone would look at what I've done. Im really new at this and im sure theres alot of cleaning up to do. I may have made this way more complicated then it needs to be. Thanks in advance for your help! Sub CopyPaste2() Application.ScreenUpdating = False Dim wbCurrent As Workbook files_to_open = _ Application.GetOpenFilename("Excel files (*.xls), _*.xls", , , , True) If Not IsArray(files_to_open) Then MsgBox "Nothing selected" Exit Sub Else For i = LBound(files_to_open) To UBound(files_to_open) Set wbCurrent = Workbooks.Open(files_to_open(i)) Application.StatusBar = "Processing " & files_to_open(i) FinalCopy wbCurrent FinalCopy(myWB As Workbook) Range("B18").Select Application.CutCopyMode = False Selection.Cut Destination:=Range("C18") Range("B28").Select Selection.Cut Destination:=Range("C28") Range("D18").Select ActiveCell.FormulaR1C1 = "=CLEAN(RC[-1])" Range("D28").Select ActiveCell.FormulaR1C1 = "=CLEAN(RC[-1])" Range("D18").Select Selection.Copy Range("B18").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("D28").Select Application.CutCopyMode = False Selection.Copy Range("B28").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Rows("1:1").Select Selection.Delete Shift:=xlUp ChDir "C:\Documents and Settings\Owner\Desktop" Workbooks.Open Filename:= _ "C:\Documents and Settings\Owner\Desktop\Second Worksheet.xls" ActiveWindow.ScrollWorkbookTabs Position:=xlFirst ActiveWindow.ScrollWorkbookTabs Position:=xlFirst Sheets("Demographic Info").Select ActiveWindow.ScrollRow = 12 ActiveWindow.ScrollRow = 11 ActiveWindow.ScrollRow = 10 ActiveWindow.ScrollRow = 9 ActiveWindow.ScrollRow = 8 ActiveWindow.ScrollRow = 7 ActiveWindow.ScrollRow = 6 ActiveWindow.ScrollRow = 5 ActiveWindow.ScrollRow = 4 ActiveWindow.ScrollRow = 3 ActiveWindow.ScrollRow = 2 ActiveWindow.ScrollRow = 1 myWB.Activate Range("B1:B5").Select Selection.Copy Windows("Second Worksheet.xls").Activate Range("B2").Select ActiveSheet.Paste myWB.Activate Range("B8:B19").Select Application.CutCopyMode = False Selection.Copy Windows("Second Worksheet.xls").Activate Range("B10").Select ActiveSheet.Paste myWB.Activate ActiveWindow.SmallScroll Down:=18 Range("B23:B30").Select Application.CutCopyMode = False Selection.Copy Windows("Second Worksheet").Activate Range("B25").Select ActiveSheet.Paste ActiveWindow.ScrollRow = 2 ActiveWindow.ScrollRow = 3 ActiveWindow.ScrollRow = 4 ActiveWindow.ScrollRow = 5 ActiveWindow.ScrollRow = 6 ActiveWindow.ScrollRow = 7 ActiveWindow.ScrollRow = 8 ActiveWindow.ScrollRow = 9 ActiveWindow.ScrollRow = 10 ActiveWindow.ScrollRow = 11 ActiveWindow.ScrollRow = 12 Sheets("Sheet 2").Select myWB.Activate Range("B34:B44").Select Application.CutCopyMode = False Selection.Copy Windows("Second Worksheet.xls").Activate Range("B3").Select ActiveSheet.Paste myWB.Activate ActiveWindow.SmallScroll Down:=12 Range("B49:H49").Select Application.CutCopyMode = False Selection.Copy Windows("Second Worksheet.xls").Activate Range("A18").Select ActiveSheet.Paste Sheets("Sheet 3").Select myWB.Activate Rows("51:170").Select Application.CutCopyMode = False Selection.Sort Key1:=Range("A51"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A51:O86").Select Selection.Copy Windows("Second Worksheet.xls").Activate Range("A5").Select ActiveSheet.Paste myWB.Activate Range("B49").Select Selection.Copy Windows("Second Worksheet.xls").Activate ActiveWindow.SmallScroll ToRight:=4 Sheets("Sheet 3").Select ActiveWindow.SmallScroll ToRight:=3 Application.Run "MakeXML" NewFilename = Left(files_to_open(i), Len(files_to_open(i)) - 4) _ & " - Testing - please delete.xls" wbCurrent.SaveAs NewFilename wbCurrent.Close Next i End If Set wbCurrent = Nothing Application.StatusBar = False Application.ScreenUpdating = True MsgBox UBound(files_to_open) - LBound(files_to_open) + _ 1 & " files processed (hopefully)." End Function Const fPath As String = "C:\Documents and Settings\Desktop\" Dim fName As String Dim myFileName As String myFileName = "EXCEL" & Sheets("Sheet 2").Range("A18") & ".xls" fName = fPath & myFileName ActiveSheet.SaveAs Filename = fName MsgBox "File Saved to " & fName End Function THANKS! |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Macro For Saving As .txt | Excel Discussion (Misc queries) | |||
| Saving Macro - need help | Excel Programming | |||
| Saving a spreadsheet without saving the Macro | Excel Programming | |||
| Macro for Saving!! | Excel Programming | |||
| pop ups after saving to csv via macro | Excel Programming | |||
Hybrid Mode
