Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 557
Default 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
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,939
Default 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

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
CORRECTION NEEDED K[_2_] Excel Programming 3 June 2nd 08 07:13 PM
CORRECTION NEEDED IN MACRO K[_2_] Excel Programming 0 April 17th 08 10:41 AM
CORRECTION NEEDED K[_2_] Excel Programming 2 January 22nd 08 12:54 PM
correction needed K[_2_] Excel Programming 5 December 16th 07 08:32 PM
Macro correction Meltad Excel Programming 2 October 9th 06 12:15 PM


All times are GMT +1. The time now is 08:18 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"