PDA

View Full Version : Looping/Copying/Other



allison
05-20-2008, 12:36 PM
I have 20 individual workbooks that once a week, need to have some data extracted and complied for some reports.

All of the files are named the same, except for a 4 digit year indicator - and the all have the same format. I need the data that is in columns A, B and AA - and will put that into columns A, B and C.

I have written this basic code to open the file & copy some of the information.

Sub CopyData()

Dim DestBook As Workbook
Dim SrcBook As Workbook
Dim LastRow As Long


Application.ScreenUpdating = False

Set DestBook = ThisWorkbook
Set SrcBook = Workbooks.Open("L:\Asbestos\Asbestos Logs by years\Asbestos Log1997.xls")
SrcBook.Activate
With ActiveSheet
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
DestBook.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

SrcBook.Activate
With ActiveSheet
End With
Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
DestBook.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
SrcBook.Activate
With ActiveSheet
Range("AA2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
DestBook.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
SrcBook.Activate
ActiveWorkbook.Close
Application.ScreenUpdating = True
End Sub


I have a few problems with what I wrote and am looking for a bit of help, please.

1. When I am pasting the data into DestBook, how to I make sure that column A data goes into column A? column B data goes into column B? Right now, they all overlay each other in column A.

2. Because there are manu workbooks that this is going to be done on, I want the pasting to start in the first blank line. When I use the line
LastRow = Range("A" & .Rows.Count).End(xlUp).Row I get an error message. I've used that line in other code so I'm not sure if it's because there is only one row in DestBook (it's just a header row). Suggestions?

3. I really need to loop through this code for all 20 of the Workbooks. As I mentioned, the file names are all of the same except for the four digit year. Is there a way to set another variable to i (and looping from 1985 to 2008) and SrcBook to be Asbestos Log"i"?

I appreciate any suggestions!! Thanks in advance.

JimmyTheHand
05-21-2008, 12:17 AM
Hi :hi:

There are a couple of comments I'd like to add to your code.

1) When working with ranges, (e.g. using Copy and Paste/PasteSpecial methods,) it's recommended to use full range definition, with workbook, sheet and cell reference. For example, this code
SrcBook.Activate
Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy is potentially faulty, because when you activate a workbook via code, you can't be sure which worksheet will be activated. In the above example, Range("B2") could be on any worksheets in SrcBook. Unless you have only one worksheet in the workbook, you'd do best defining the sheet as well:
SrcBook.Activate
Sheets("Sheet2").Activate
Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Similarly, defining destination of Paste method is very important. This code:
DestBook.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False is extremely vulnerable, because neither destination sheet, nor destination range are not defined. So the outcome is, in no small part, chance.

2) There's no need to select ranges, if you only want to copy their contents to somewhere. Selection is only for show. It's good for indicating what the code is doing, but has no other use that I know of. Copying range contents can be condensed into one line of code:
SourceRange.Copy Destination:=DestinationRange
Of course, the ranges must be defined first, but no selection is necessary.

3) The code you use for determining last row
LastRow = Range("A" & .Rows.Count).End(xlUp).Row is also incomplete, because workbook and worksheet references are missing. This code, as it is, refers to the active sheet of the active workbook. That sheet might or might not be the one you actually need.
It's better this way:
Dim WS As Worksheet
Set WS = Workbooks("Book1.xls").Sheets("Sheet1")
LastRow = WS.Range("A" & WS.Rows.Count).End(xlUp).Row

BTW, the ".Rows.Count" part is wrong because of the first dot (highlighted in red). That dot makes it neccessary to have a prior worksheet reference.
'Either
With Sheets("Sheet1")
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
'Or
LastRow = Sheets("Sheet1").Range("A" & Sheets("Sheet1").Rows.Count).End(xlUp).Row
'Or
LastRow = Range("A" & Rows.Count).End(xlUp).Row 'No dot here


Now, I put together something you could use. It includes a prompt for files to process, looping through the files and copying the desired ranges.
Sub CopyData()
Dim arrFiles, FileCount As Long
Dim SrcBook As Workbook
Dim DestSheet As Worksheet, SrcSheet As Worksheet
Dim DestRange As Range, SrcRange As Range
'Definition of DestSheet is to be modified as appropriate
Set DestSheet = ThisWorkbook.Sheets(1)
'Prompting the user for files. Multiple files can be selected, even 20 at a time.
arrFiles = Application.GetOpenFilename("Excel Workbooks (*.xls), *.xls", , "Select the files for processing", , True)
'Loop through the files
For FileCount = 1 To UBound(arrFiles)
'Open source file
Set SrcBook = Workbooks.Open(arrFiles(FileCount))
'Definition of SrcSheet is to be modified as appropriate
Set SrcSheet = SrcBook.Sheets(1)
'Setting SrcRange to the continuous range from A2 downwards
Set SrcRange = SrcSheet.Range("A2")
Set SrcRange = Range(SrcRange, SrcRange.End(xlDown))
'Adding to SrcRange the coresponding ranges in columns B and AA
Set SrcRange = Union(SrcRange, SrcRange.Offset(, 1), SrcRange.Offset(, 26))
Set DestRange = DestSheet.Range("A" & DestSheet.Rows.Count).End(xlUp).Offset(1)
'Copy and Paste
SrcRange.Copy
DestRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.DisplayAlerts = False
SrcBook.Close
Application.DisplayAlerts = True
Next
End Sub


This all could be done without even opening the source files, but presently I have no time to work that out. Maybe someone else will help you with that, if you like the idea.

HTH

Jimmy