Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 07-29-2011, 01:27 AM
Snvlsfoal Snvlsfoal is offline Loop through folder of workbooks and copy range to other workbook Windows XP Loop through folder of workbooks and copy range to other workbook Office 2004 for Mac
Banned
Loop through folder of workbooks and copy range to other workbook
 
Join Date: Jul 2011
Posts: 9
Snvlsfoal is on a distinguished road
Default Loop through folder of workbooks and copy range to other workbook

Hi All,



I have Folder named "Test" in my D: drive. this folder has many workbooks with different names. i want to open one by one workbook and copy some range like a2:z500 and paste it to a destination workbook. please help me!!
Reply With Quote
  #2  
Old 07-29-2011, 05:50 AM
Catalin.B Catalin.B is offline Loop through folder of workbooks and copy range to other workbook Windows Vista Loop through folder of workbooks and copy range to other workbook Office 2007
Expert
 
Join Date: May 2011
Location: Iaşi, Romānia
Posts: 386
Catalin.B is on a distinguished road
Default

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:





















Reply With Quote
  #3  
Old 07-29-2011, 05:54 AM
Catalin.B Catalin.B is offline Loop through folder of workbooks and copy range to other workbook Windows Vista Loop through folder of workbooks and copy range to other workbook Office 2007
Expert
 
Join Date: May 2011
Location: Iaşi, Romānia
Posts: 386
Catalin.B is on a distinguished road
Default

That looks bad...try again:
'Starting row on source worksheet
StartRow = 11

'Get the workbooks to open
xlsFiles = Application.GetOpenFilename(FileFilter:="Excel files (*.xls), *.xls", MultiSelect:=True)
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, "CG"), .Cells(LastRow, "CG")).Value
End With
End If
C = C + 1
SrcWkb.Close
Next wkbname

End Sub
Reply With Quote
  #4  
Old 07-29-2011, 05:55 AM
Catalin.B Catalin.B is offline Loop through folder of workbooks and copy range to other workbook Windows Vista Loop through folder of workbooks and copy range to other workbook Office 2007
Expert
 
Join Date: May 2011
Location: Iaşi, Romānia
Posts: 386
Catalin.B is on a distinguished road
Default

see this one:


Sub RunCodeOnAllXLSFiles()
Dim i As Integer
Dim wbResults As Workbook
Dim wbCodeBook As Workbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next

Set wbCodeBook = ThisWorkbook

With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = "C:\MyDocuments\TestResults"
.FileType = msoFileTypeExcelWorkbooks

If .Execute > 0 Then 'Workbooks in folder
For i = 1 To .FoundFiles.Count 'Loop through all.
'Open Workbook x and Set a Workbook variable to it
Set wbResults = Workbooks.Open(.FoundFiles(i))

'DO YOUR CODE HERE

Next i
End If


For i = 1 To .FoundFiles.Count 'Loop through all. 'Open Workbook x and Set a Workbook variable to it Set wbResults = Workbooks.Open(.FoundFiles(i)) 'DO YOUR CODE HERE 'Close Workbook and Save changes, wbResults.Close SaveChanges:=True Next i
End With

On Error Goto 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
Reply With Quote
Reply

Thread Tools
Display Modes


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
Loop through folder of workbooks and copy range to other workbook macro to transfer data from one workbook to another workbook virsojour Excel Programming 5 02-01-2011 08:58 PM
Loop through folder of workbooks and copy range to other workbook 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

Other Forums: Access Forums

All times are GMT -7. The time now is 03:13 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft