#1   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 9
Default Macros - using loops

I'm trying to create a macro to open all the Excel files in a folder and
copy/paste the second line of each worksheet in a separate file already
created. Could somebody help me? I don't know a lot about macros. Thanks!
  #2   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 2,203
Default Macros - using loops

The code below should do the trick for you. To put the code into your
workbook, open it up and press [Alt]+[F11] to open the Visual Basic Editor
(VBE). In the VBE use its menu to Insert -- Module. Then copy the code
below and paste it into the code module presented to you. Close the VBE and
save the workbook in the SAME FOLDER with the other files to be processed.
Run the macro as noted in the comments in the code depending on your version
of Excel.

It doesn't copy the rows into some other workbook, but it does copy them
into 'Sheet2' of the workbook you put the code into, then you can copy all of
it from that workbook into your prepared workbook later. It also only copies
the values shown in the other workbooks, not any formulas nor any formatting.

Sub CopyAll2ndRows()
'place this workbook into the same
'folder with the Excel files you want
'to copy 2nd row from each sheet from
'Run this macro from this workbook's
' Tools -- Macro -- Macros menu
'or
' from the Developer tab in Excel 2007
' click "Macros" in the {Code} group.
'
' If the Developer tab is not visible,
' Click the Office button, then
' Click the [Excel Options] button and
' in the {Popular} group check the box
' next to "Show Developer tab in the Ribbon"

Const rowToCopy = 2
Dim anyWB As Workbook
Dim anyWS As Worksheet
Dim anyRow As Range
Dim rootFolder As String
Dim bookName As String
Dim copyToWS As Worksheet
Dim rowPointer As Long

'find the path to the folder this file is in
'this gets complete path and workbook name
rootFolder = ThisWorkbook.FullName
'remove the workbook name, leaving the path
rootFolder = Left(rootFolder, InStrRev(rootFolder, _
Application.PathSeparator))
'we will copy all contents of row 2
'on all sheets in all other workbooks
'in the same folder to 'Sheet2' in this workbook
'begin by removing any existing entries
' you can copy from it to another book easily
Set copyToWS = ThisWorkbook.Worksheets("Sheet2")
'begin working with the other workbooks
'we look for any file with filename ending in
'.xls and either any other character or no other
'character, such as .xls, .xlsx, .xlsm, etc.
bookName = Dir(rootFolder & "*.xls*")
Application.ScreenUpdating = False ' improve performance
'initialize rowPointer to start copying to row 2
'on 'Sheet2' of this workbook
rowPointer = 2
Do While bookName < ""
'don't do anything with this workbook when found
If bookName < ThisWorkbook.Name Then
'it is some other workbook, process it
'suppress alerts
Application.DisplayAlerts = False
'disable any automatic response to
'events such as Workbook_Open or
'Worksheet_Activate
Application.EnableEvents = False
'open the other workbook;
' do not update links, open as read only
Workbooks.Open rootFolder & bookName, False, True
Set anyWB = ActiveWorkbook
ThisWorkbook.Activate
'start working through all sheets in the
'other workbook
For Each anyWS In anyWB.Worksheets
Set anyRow = anyWS.Rows(rowToCopy & ":" & rowToCopy)
anyRow.Copy
'same as Edit -- Paste Special with 'Values' chosen
copyToWS.Range("A" & rowPointer).PasteSpecial xlPasteValues
Application.CutCopyMode = False
'increment rowPointer so we don't overwrite data
rowPointer = rowPointer + 1
Set anyRow = Nothing ' good housekeeping
Next ' end of anyWS loop
'we are finished with the other workbook, close it
anyWB.Close False ' do not save changes (none were made)
Set anyWB = Nothing ' good housekeeping
End If
bookName = Dir() ' get next possible filename
Loop ' end of bookName not empty string loop
're-enable alerts and event processing
Application.DisplayAlerts = True
Application.EnableEvents = True
copyToWS.Activate
Application.Goto Range("A1") ' row 1 always empty
Set copyToWS = Nothing ' good housekeeping
MsgBox "All workbooks have been processed in this folder"
End Sub


"Happy" wrote:

I'm trying to create a macro to open all the Excel files in a folder and
copy/paste the second line of each worksheet in a separate file already
created. Could somebody help me? I don't know a lot about macros. Thanks!

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
loops???? harry buggy Excel Worksheet Functions 2 August 14th 07 06:33 PM
Loops SaraJane Excel Discussion (Misc queries) 11 May 26th 07 04:47 AM
LOOPS IN MACROS Heather O'Malley Excel Discussion (Misc queries) 3 November 6th 06 06:04 PM
Do loops grandfilth Excel Discussion (Misc queries) 1 November 10th 05 12:00 AM
Using For - Next Loops in VB Biomed New Users to Excel 1 March 21st 05 09:35 PM


All times are GMT +1. The time now is 07:50 PM.

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

About Us

"It's about Microsoft Excel"