K
K
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
"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