|
Correction Needed in Macro
I need correction in macro below. Basically I am tring to open every
"xlsx" format file in a folder and copy specified ranges of that file into specified range of Workbook("DATA") and after pasting data I want to close that "xlsx" file with "Save changes = True" and i want this to happen untill there is no file left in that folder. I am getting error messages when i run this macro below. Please can any friend can help that what is wrong with this macro or what am i doing wrong. Any help will be much appricated. Sub Update() Dim fldrName As String, fName As String, wb As Workbooks fldrName = "F:\TRANSFERS & VIREMENTS RECORD\" fName = Dir(fldrName & "*.xlsx") LstCl = Cells(Rows.Count, "B").End(xlUp).Row LstCl2 = Cells(Rows.Count, "A").End(xlUp).Row LstCl3 = Cells(Rows.Count, "M").End(xlUp).Row LstCl4 = Cells(Rows.Count, "N").End(xlUp).Row LstCl5 = Cells(Rows.Count, "O").End(xlUp).Row LstCl6 = Cells(Rows.Count, "P").End(xlUp).Row LstCl7 = Cells(Rows.Count, "Q").End(xlUp).Row LstCl8 = Cells(Rows.Count, "R").End(xlUp).Row LstCl9 = Cells(Rows.Count, "S").End(xlUp).Row Do While fName < "" wb.Open (fldrName & fName) wb(fName).Activate ActiveSheet.Unprotect Password:="mbc" ActiveSheet.Range(Range("B15:B" & LstCl), Range("L" & LstCl)).Copy wb("DATA.xlsm").Activate ActiveSheet.Range("B" & LstCl + 1).PasteSpecial xlPasteValues wb(fName).Activate ActiveSheet.Range("K1").Copy wb("DATA.xlsm").Activate ActiveSheet.Range(Range("A" & LstCl2 + 1), Range("A" & LstCl)).PasteSpecial xlPasteValues wb(fName).Activate ActiveSheet.Range("K6").Copy wb("DATA.xlsm").Activate ActiveSheet.Range(Range("M" & LstCl3 + 1), Range("M" & LstCl)).PasteSpecial xlPasteValues wb(fName).Activate ActiveSheet.Range("K4").Copy wb("DATA.xlsm").Activate ActiveSheet.Range(Range("N" & LstCl4 + 1), Range("N" & LstCl)).PasteSpecial xlPasteValues wb(fName).Activate ActiveSheet.Range("D8").Copy wb("DATA.xlsm").Activate ActiveSheet.Range(Range("O" & LstCl5 + 1), Range("O" & LstCl)).PasteSpecial xlPasteValues wb(fName).Activate ActiveSheet.Range("D6").Copy wb("DATA.xlsm").Activate ActiveSheet.Range(Range("P" & LstCl6 + 1), Range("P" & LstCl)).PasteSpecial xlPasteValues wb(fName).Activate ActiveSheet.Range("D10").Copy wb("DATA.xlsm").Activate ActiveSheet.Range(Range("Q" & LstCl7 + 1), Range("Q" & LstCl)).PasteSpecial xlPasteValues wb(fName).Activate ActiveSheet.Range("K8").Copy wb("DATA.xlsm").Activate ActiveSheet.Range(Range("R" & LstCl8 + 1), Range("R" & LstCl)).PasteSpecial xlPasteValues wb(fName).Activate ActiveSheet.Range("K10").Copy wb("DATA.xlsm").Activate ActiveSheet.Range(Range("S" & LstCl9 + 1), Range("S" & LstCl)).PasteSpecial xlPasteValues Application.CutCopyMode = False ActiveSheet.Range("A1").Select wb(fName).Activate ActiveSheet.Protect Password:="mbc" wb(fName).Close True fName = Dir() Loop End Sub |
Correction Needed in Macro
You seem to misunderstand how the workbook object functions. The workbook
object creates a reference to a specific workbook. The same wha tthat you can use activeworkbook, you will be able to use the workbook object. Note that the workbook where the code is running will is always ThisWorkbook. Also by using the workbook objects there is no reason to select or activate things. finallly if all you are after is the values then just set the values on your destination workbook equal to the values in your source books... dim wb as workbook dim wksSource as worksheet dim wksDestination as worksheet set wksDestination = thisworkbook.sheets("Destination") 'or whatever sheet set wb = workbooks.open(fldrName & fName) set wksSource = wb.sheets("Source") 'explicitly define the source sheet wksdestination.range("A1:A10").value = wkssource.range("B1:B10").value -- HTH... Jim Thomlinson "K" wrote: I need correction in macro below. Basically I am tring to open every "xlsx" format file in a folder and copy specified ranges of that file into specified range of Workbook("DATA") and after pasting data I want to close that "xlsx" file with "Save changes = True" and i want this to happen untill there is no file left in that folder. I am getting error messages when i run this macro below. Please can any friend can help that what is wrong with this macro or what am i doing wrong. Any help will be much appricated. Sub Update() Dim fldrName As String, fName As String, wb As Workbooks fldrName = "F:\TRANSFERS & VIREMENTS RECORD\" fName = Dir(fldrName & "*.xlsx") LstCl = Cells(Rows.Count, "B").End(xlUp).Row LstCl2 = Cells(Rows.Count, "A").End(xlUp).Row LstCl3 = Cells(Rows.Count, "M").End(xlUp).Row LstCl4 = Cells(Rows.Count, "N").End(xlUp).Row LstCl5 = Cells(Rows.Count, "O").End(xlUp).Row LstCl6 = Cells(Rows.Count, "P").End(xlUp).Row LstCl7 = Cells(Rows.Count, "Q").End(xlUp).Row LstCl8 = Cells(Rows.Count, "R").End(xlUp).Row LstCl9 = Cells(Rows.Count, "S").End(xlUp).Row Do While fName < "" wb.Open (fldrName & fName) wb(fName).Activate ActiveSheet.Unprotect Password:="mbc" ActiveSheet.Range(Range("B15:B" & LstCl), Range("L" & LstCl)).Copy wb("DATA.xlsm").Activate ActiveSheet.Range("B" & LstCl + 1).PasteSpecial xlPasteValues wb(fName).Activate ActiveSheet.Range("K1").Copy wb("DATA.xlsm").Activate ActiveSheet.Range(Range("A" & LstCl2 + 1), Range("A" & LstCl)).PasteSpecial xlPasteValues wb(fName).Activate ActiveSheet.Range("K6").Copy wb("DATA.xlsm").Activate ActiveSheet.Range(Range("M" & LstCl3 + 1), Range("M" & LstCl)).PasteSpecial xlPasteValues wb(fName).Activate ActiveSheet.Range("K4").Copy wb("DATA.xlsm").Activate ActiveSheet.Range(Range("N" & LstCl4 + 1), Range("N" & LstCl)).PasteSpecial xlPasteValues wb(fName).Activate ActiveSheet.Range("D8").Copy wb("DATA.xlsm").Activate ActiveSheet.Range(Range("O" & LstCl5 + 1), Range("O" & LstCl)).PasteSpecial xlPasteValues wb(fName).Activate ActiveSheet.Range("D6").Copy wb("DATA.xlsm").Activate ActiveSheet.Range(Range("P" & LstCl6 + 1), Range("P" & LstCl)).PasteSpecial xlPasteValues wb(fName).Activate ActiveSheet.Range("D10").Copy wb("DATA.xlsm").Activate ActiveSheet.Range(Range("Q" & LstCl7 + 1), Range("Q" & LstCl)).PasteSpecial xlPasteValues wb(fName).Activate ActiveSheet.Range("K8").Copy wb("DATA.xlsm").Activate ActiveSheet.Range(Range("R" & LstCl8 + 1), Range("R" & LstCl)).PasteSpecial xlPasteValues wb(fName).Activate ActiveSheet.Range("K10").Copy wb("DATA.xlsm").Activate ActiveSheet.Range(Range("S" & LstCl9 + 1), Range("S" & LstCl)).PasteSpecial xlPasteValues Application.CutCopyMode = False ActiveSheet.Range("A1").Select wb(fName).Activate ActiveSheet.Protect Password:="mbc" wb(fName).Close True fName = Dir() Loop End Sub |
| All times are GMT +1. The time now is 08:45 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com