Correction Needed in Macro

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
 
J

Jim Thomlinson

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top