Loop through folder of workbooks and copy range to other workbook

Catalin.B · #2 07-29-2011, 05:50 AM

Try this codes, see how it fits you:
Sub Collect_Data() Dim DstWks2 As Worksheet Dim LastRow As Long Dim R As Long Dim SrcWkb As Workbook Dim StartRow As Long Dim wkbname As Variant Dim xlsFiles As Variant 'Starting column and row for the destination workbook C = 1 R = 1 'Set references to destination workbook worksheet objects Set DstWks1 = ThisWorkbook.Worksheets("Formdata") Set DstWks2 = ThisWorkbook.Worksheets("Formdata2") 'Starting row on source worksheet StartRow = 11 'Get the workbooks to open xlsFiles = Application.GetOpenFilename(FileFilter:="Excel files (*.xls), *.xls", MultiSelect:=True) Application.AskToUpdateLinks = False If VarType(xlsFiles) = vbBoolean Then Exit Sub 'Loop through each workbook and copy the data to this workbook For Each wkbname In xlsFiles Set SrcWkb = Workbooks.Open(Filename:=wkbname, ReadOnly:=True) LastRow = SrcWkb.Worksheets("Data").Cells(Rows.Count, "BG").End(xlUp).Row If LastRow >= StartRow Then With SrcWkb.Worksheets("Data") DstWks1.Cells(R, C).Resize(LastRow - StartRow + 1, 1).Value = _ .Range(.Cells(StartRow, "BG"), .Cells(LastRow, "BG")).Value End With End If LastRow = SrcWkb.Worksheets("Data").Cells(Rows.Count, "CB").End(xlUp).Row If LastRow >= StartRow Then With SrcWkb.Worksheets("Data") DstWks2.Cells(R, C).Resize(LastRow - StartRow + 1, 1).Value = _ .Range(.Cells(StartRow, "CB"), .Cells(LastRow, "CB")).Value End With End If C = C + 1 SrcWkb.Close savechanges:=False Next wkbname End Sub

or:

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
outlook 2003 always not remove temp copy of opened attachments in temporary folder	c.itech	Outlook	0	06-20-2011 10:34 PM
macro to transfer data from one workbook to another workbook	virsojour	Excel Programming	5	02-01-2011 08:58 PM
Select a range in one one workbook while working in other workbook	Slow&Steady	Excel	1	02-21-2010 03:34 AM
Copy email to another folder	loc	Outlook	0	12-26-2006 07:39 AM
Page Numbering in Workbooks & Print set up problem	mdouble588	Excel	0	05-21-2006 10:29 AM