Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Old June 17th 18, 11:35 AM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Mar 2007
Posts: 8
Default Help required for macro

Dear ALl
I want a little help 1 I want a macro for following

I have year wise folder ( e g 2015,2016) in this folder there is monthwise folder (jan,feb....)
In month wise folder there are five workbook(AAA,BBB,CCC,DDD,EEE)
In each workbook there will be many sheet(a,b,c,d,....)
I want to particular sheet(suppose sheet c) to be copy from each work book and paste in one new workbbk
can anyone help me
Thanks in advance
Regards
Shrinivas

  #2   Report Post  
Old June 17th 18, 06:10 PM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Oct 2003
Posts: 506
Default Help required for macro

shrini wrote:

I want a little help 1 I want a macro for following

I have year wise folder ( e g 2015,2016) in this folder there is
monthwise folder (jan,feb....)
In month wise folder there are five workbook(AAA,BBB,CCC,DDD,EEE)
In each workbook there will be many sheet(a,b,c,d,....)
I want to particular sheet(suppose sheet c) to be copy from each work
book and paste in one new workbbk


This wasn't tested very thoroughly, but it seems to work.

Sub startup()
'This is the sub you run. It calls the worker sub and passes the top
'level of your directory tree (the directory that has the "year"
'subdirs). It must be a full path or expect some serious failure.
grabEverything "D:\1"
End Sub

Sub grabEverything(where As String)
'This sub does all the work.
Dim working As String, L0, L1
Dim src As Workbook, tgt As Workbook
ReDim dirlist1(0) As String, dirlist2(0) As String

Set tgt = ActiveWorkbook
ChDrive where
ChDir where
'build top-level dir list
working = Dir$("*", vbDirectory)
While Len(working)
If (GetAttr(working) And vbDirectory) And _
(Left$(working, 1) < ".") Then
ReDim Preserve dirlist1(UBound(dirlist1) + 1)
dirlist1(UBound(dirlist1)) = working
End If
working = Dir$
Wend
If UBound(dirlist1) = 0 Then Exit Sub 'no dirs found
For L0 = 1 To UBound(dirlist1)
'clear any previous use of dirlist2
ReDim dirlist2(0)
ChDir dirlist1(L0)
working = Dir$("*", vbDirectory)
'build subdir list
While Len(working)
If (GetAttr(working) And vbDirectory) And _
(Left$(working, 1) < ".") Then
ReDim Preserve dirlist2(UBound(dirlist2) + 1)
dirlist2(UBound(dirlist2)) = working
End If
working = Dir$
Wend
If UBound(dirlist2) 1 Then 'subdirs found
For L1 = 1 To UBound(dirlist2)
ChDir dirlist2(L1)
working = Dir$("*.xls*")
While Len(working)
Set src = Workbooks.Open(Filename:=working, _
UpdateLinks:=False, ReadOnly:=True)
'This avoids the need to worry about checking if the named sheet
'exists -- if it doesn't, Excel will ignore the error and march
'on. This also means that if a rename fails, further attempts to
'copy will also fail.
On Error Resume Next
src.Sheets("C").Copy Befo=tgt.Sheets(1)
'Have to rename the sheet to avoid name collision.
'We'll use the original file's path.
'Should end up as yyyy-mmm-???, e.g. "2018-jun-aaa".
tgt.Sheets("C").Name = dirlist1(L0) & "-" & dirlist2(L1) & "-" _
& Left$(working, InStrRev(working, ".") - 1)
'back to normal error handling
On Error GoTo 0
src.Close SaveChanges:=False
working = Dir$
Wend
ChDir ".."
Next L1
End If
ChDir ".."
Next L0
End Sub

--
If my heart was still alive, I know it would surely break.
  #3   Report Post  
Old June 20th 18, 06:11 PM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Mar 2007
Posts: 8
Default Help required for macro

On Sunday, June 17, 2018 at 4:05:54 PM UTC+5:30, shrini wrote:
Dear ALl
I want a little help 1 I want a macro for following

I have year wise folder ( e g 2015,2016) in this folder there is monthwise folder (jan,feb....)
In month wise folder there are five workbook(AAA,BBB,CCC,DDD,EEE)
In each workbook there will be many sheet(a,b,c,d,....)
I want to particular sheet(suppose sheet c) to be copy from each work book and paste in one new workbbk
can anyone help me
Thanks in advance
Regards



dear auric thanks for help I will check and will let you know
Shrinivas




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
Macro required pcorcele Excel Programming 4 May 2nd 12 03:52 AM
Macro required please Dr Hackenbush Excel Discussion (Misc queries) 4 February 10th 10 09:29 AM
macro required.. [email protected] Excel Programming 1 December 15th 08 07:30 PM
Macro required PCOR Excel Worksheet Functions 3 December 11th 05 07:36 PM
Pilgrim needs help: Effecting keystroks required by a macro nested within a macro. [email protected] Excel Programming 1 May 14th 05 03:46 AM


All times are GMT +1. The time now is 09:39 PM.

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

About Us

"It's about Microsoft Excel"

 

Copyright © 2017