Hi all, I resolved it myself.. thanks. just replaced this workbook by active workbook
Posts by RAAGA
-
-
I had this working macro perfectly fine. I wanted to fine tune and hence I wanted to execute the macro from a different file and I did the below. but I get error on execution as out of range.. Didn't know whats wrong in this... can anyone help me in this?
Code
Display MoreOption Explicit Sub CopyDataFromMultipleWorkbooks() Dim wbMaster As Workbook Dim wsMaster As Worksheet Set wbMaster = Workbooks.Open(Worksheets("sheet1").Cells(3, 4).Value) Set wsMaster = wbMaster.Sheets("Service Order Template") Const TEMPLATE = "Service Order Template" Const SITE_TEMPLATE = "Site Creation Template(Project)" Dim FSO As Object Dim BrowseFolder As String Dim oFolder As Object ' select folder Set FSO = CreateObject("Scripting.FileSystemObject") With Application.FileDialog(msoFileDialogFolderPicker) .Title = "Select the folder with source files" If Not .Show = 0 Then BrowseFolder = .SelectedItems(1) Else MsgBox "Cancelled selection", vbCritical Exit Sub End If End With 'Debug.Print "BrowseFolder = " & BrowseFolder Application.DisplayAlerts = False Application.ScreenUpdating = False Dim wbSource As Workbook, wsSource As Worksheet, wrSource As Worksheet, rngSource As Range Dim f As Object, fname As String Dim lastSrcRow As Long Dim insertRow1 As Long, insertRow2 As Long, count As Long Dim lrow As Long Set wbMaster = ThisWorkbook Set wsMaster = wbMaster.Sheets(TEMPLATE) insertRow1 = 22 insertRow2 = 10 ' start of row 10 copies on sheet 2 of master Set oFolder = FSO.GetFolder(BrowseFolder) count = 0 ' scan files For Each f In oFolder.Files If f.Name Like "*.xls*" Then fname = BrowseFolder & Application.PathSeparator & f.Name 'Debug.Print fname Set wbSource = Workbooks.Open(fname, False, True) ' open no link update, read-only Set wsSource = wbSource.Sheets(TEMPLATE) lastSrcRow = wsSource.Cells(Rows.count, 18).End(xlUp).Row Set rngSource = wsSource.Range("A22:AS" & lastSrcRow) ' AS=col45 Debug.Print f.Name, wsSource.Name, rngSource.Address rngSource.Copy wsMaster.Cells(insertRow1, 1) insertRow1 = insertRow1 + rngSource.Rows.count ' copy additional needed range D5 : D18 from source to range D5 on master wsSource.Range("D5:D18").Copy wsMaster.Range("D5") Dim VSource As Range Set wrSource = wbSource.Sheets(SITE_TEMPLATE) lrow = wrSource.Cells(Rows.count, "N").End(xlUp).Row Set VSource = wrSource.Range("A10:Z" & lrow) 'copying row 10 from sheet 2 with name "Site Creation Template(Project)" wbSource.Sheets(SITE_TEMPLATE).Rows(10 & ":" & lrow).Copy wbMaster.Sheets(SITE_TEMPLATE).Range("A" & insertRow2) insertRow2 = insertRow2 + VSource.Rows.count wbSource.Close False count = count + 1 End If Next Dim filename As String Dim SeriesValue As String SeriesValue = InputBox("computer Networks", "Enter Series number") filename = "_" & SeriesValue & "_COT " & count & " SPOs(SO-SVO-PO) with PDF copy_CPO " & Range("D8") ActiveWorkbook.SaveAs filename:=Format(Date, "yyyymmdd") & filename & ".xlsx", FileFormat:=xlOpenXMLWorkbook Application.DisplayAlerts = True Application.ScreenUpdating = True MsgBox count & " Order Entry Templates processed", , "computer NETWORKS" End Sub
-
Hey Folks...!!
I have a VBA Script that will copy multiple file data from a folder to a Template that is pre loaded in the same file. My requirements is
1. I want to add some command button and move the template to somewhere hidden. ( Its ok if a folder has to be maintained).
2. At the end I dont want my macro file to close since I need to continue working with same Macro file.
Please tell me a possible idea... My code is as below.Code
Display MoreOption Explicit Sub CopyDataFromMultipleWorkbooks() Const TEMPLATE = "Service Order Template" Const SITE_TEMPLATE = "Site Creation Template(Project)" Dim FSO As Object Dim BrowseFolder As String Dim oFolder As Object ' select folder Set FSO = CreateObject("Scripting.FileSystemObject") With Application.FileDialog(msoFileDialogFolderPicker) .Title = "Select the folder with source files" If Not .Show = 0 Then BrowseFolder = .SelectedItems(1) Else MsgBox "Cancelled selection", vbCritical Exit Sub End If End With 'Debug.Print "BrowseFolder = " & BrowseFolder Application.DisplayAlerts = False Application.ScreenUpdating = False Dim wbMaster As Workbook, wsMaster As Worksheet Dim wbSource As Workbook, wsSource As Worksheet, wrSource As Worksheet, rngSource As Range Dim f As Object, fname As String Dim lastSrcRow As Long Dim insertRow1 As Long, insertRow2 As Long, count As Long Dim lrow As Long Set wbMaster = ThisWorkbook Set wsMaster = wbMaster.Sheets(TEMPLATE) insertRow1 = 22 insertRow2 = 10 ' start of row 10 copies on sheet 2 of master Set oFolder = FSO.GetFolder(BrowseFolder) count = 0 ' scan files For Each f In oFolder.Files If f.Name Like "*.xls*" Then fname = BrowseFolder & Application.PathSeparator & f.Name 'Debug.Print fname Set wbSource = Workbooks.Open(fname, False, True) ' open no link update, read-only Set wsSource = wbSource.Sheets(TEMPLATE) lastSrcRow = wsSource.Cells(Rows.count, 18).End(xlUp).Row Set rngSource = wsSource.Range("A22:AS" & lastSrcRow) ' AS=col45 Debug.Print f.Name, wsSource.Name, rngSource.Address rngSource.Copy wsMaster.Cells(insertRow1, 1) insertRow1 = insertRow1 + rngSource.Rows.count ' copy additional needed range D5 : D18 from source to range D5 on master wsSource.Range("D5:D18").Copy wsMaster.Range("D5") Dim VSource As Range Set wrSource = wbSource.Sheets(SITE_TEMPLATE) lrow = wrSource.Cells(Rows.count, "N").End(xlUp).Row Set VSource = wrSource.Range("A10:Z" & lrow) 'copying row 10 from sheet 2 with name "Site Creation Template(Project)" wbSource.Sheets(SITE_TEMPLATE).Rows(10 & ":" & lrow).Copy wbMaster.Sheets(SITE_TEMPLATE).Range("A" & insertRow2) insertRow2 = insertRow2 + VSource.Rows.count wbSource.Close False count = count + 1 End If Next ' if you don't need to highlight the whole row - remove the ".EntireRow" part ?---?---?----? wsMaster.Range("M20:M" & insertRow1 - 1).SpecialCells(xlCellTypeBlanks).EntireRow.Interior.Color = vbYellow wsMaster.Cells.Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ReadingOrder = xlContext End With With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ReadingOrder = xlContext End With Selection.EntireColumn.Hidden = False Selection.Columns.AutoFit wsMaster.Range("A1").Select ' Check next cell in range Next rrcell Dim filename As String Dim SeriesValue As String SeriesValue = InputBox("computer network", "Enter Series number") filename = "_" & SeriesValue & "_COT " & count & " SPOs(SO-SVO-PO) with PDF copy_CPO " & Range("D8") ActiveWorkbook.SaveAs filename:=Format(Date, "yyyymmdd") & filename & ".xlsx", FileFormat:=xlOpenXMLWorkbook Application.DisplayAlerts = True Application.ScreenUpdating = True MsgBox count & " Order Entry Templates processed", , " computer network " End Sub
-
Im not sure this is still possible... I referred few posts but they dont work with current office edition..
I have a folder with say around 100 excel workbooks. I need a macro to
1. Open each file in the directory specified
2. Read the contents of a particular cell, E8
3. Create a folder in the same directory with the value of E8
4. And, move the excel workbook itself to that folder.
5. Then it opens the next file
6. If the value of E8 is the same as that in the first workbook, it simply moves it to the already created folder, else it creates another folder with the new value of E8 and moves it there.
Note: The files are not always saved in a static file path.
-
-
I have a set of data in which when there is value in column B then i need to fill corresponding column A with number series 1,2,3... is this possible in VBA?? can anyone help me on it with whats the exact way to get it done??
-
yes perfectly working!!
-
Code
Display MoreSub FolderDetails() Dim FSO As New FileSystemObject Set FSO = CreateObject("Scripting.FileSystemObject") Dim rRng As Range, rCl As Range Dim sFolder As String ''// Open the select folder prompt With Application.FileDialog(msoFileDialogFolderPicker) If .Show = -1 Then ' if OK is pressed sFolder = .SelectedItems(1) End If End With Set rRng = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)) For Each rCl In rRng If FSO.FileExists(sFolder & Application.PathSeparator & rCl.Value & ".xlsx") Then rCl.Offset(, 1).Value = sFolder Else: rCl.Offset(, 1).Value = "The File Does Not Exist" End If Next rCl End Sub
-
hi Roy, please ignore. I debugged it myself. there was a "." missing before "xlsx".. thanks mate... your are awesome!!
-
hi roy, script runs well. but I get "The File Does Not Exist" even though Value and file name are same
-
Hi Roy!!
Please review below for better understanding.
for example: I have a value "AAA", "BBB",and so on in column A1,A2 similarly I have a set of excel files in a folder with name AAA.xlsx, BBB.xlsx.
Ill choose folder path to macro manually everytime.
Finally, by comparing the cell value in column A and file name in the folder, the file path should be displayed in column B for matched items.
-
I need some ideas here... I have a column which has file names. I have a folder which has all the excel files. Is it possible to link both these and get the file path in adjacent cell ?
-
HI Roy.. I have got a solution!! thanks for your work ... if you could please delete the below conversations ill proceed to post the code here as answer...
-
yes... row 10 from sheet "Site Creation Template(Project)"
-
brother please don't refer any code in there. that is a separate operation... Please advise on my requirement. Ill use my knowledge to consolidate them ... ( Since explaining everything is creating too much of confusion!! )
-
Hi Roy , Ill make it little clear and simpler... please ignore all confusions above and check the below.
1. I need to browse and set path for files that I have in a folder.
2. Copy row 10 from all the files in that folder and paste it in the master sheet that that has the macro.
Please refer the attachment below. Kindly note that I am not trying using this forum as service provider. I have given the area I am failing to achieve In a statement manner.
-
thanks my friend!!
-
hi roy, any idea that could help me here?
-
hi roy, please refer the file attached.
-
the sheet which i attached is a sample. the exact sheet needs all those functions!!!