If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below. |
|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
editing macro to pull multiple cells instead of a single cell
Thanks to a very helpful gentleman on these boards, I have
used the below pasted code, I have created a macro that pulls the values from cell B4 in all the sheets in a folder and puts them in column A on a new sheet. I'm wondering if someone can help me edit the code so that I can pull from four non-adjacent cells and then dump into columns A-D in my new sheet. The cells in question are B4, B6, B7, and G4. Thanks, spence Sub TestFile1() Dim basebook As Workbook Dim mybook As Workbook Dim sourceRange As Range Dim destrange As Range Dim rnum As Long Dim SourceRcount As Long Dim FNames As String Dim MyPath As String Dim SaveDriveDir As String SaveDriveDir = CurDir MyPath = "C:\Documents and Settings\rspence\Desktop\Updated Reports" ChDrive MyPath ChDir MyPath FNames = Dir("*.xls") If Len(FNames) = 0 Then MsgBox "no files in the Directory" ChDrive SaveDriveDir Exit Sub End If Application.ScreenUpdating = False Set basebook = ThisWorkbook basebook.Worksheets(1).Cells.Clear rnum = 1 Do While FNames "" Set mybook = Workbooks.Open(FNames) Set sourceRange = mybook.Worksheets(1).Range("B4") SourceRcount = sourceRange.Rows.Count Set destrange = basebook.Worksheets(1).Cells(rnum, "A") With sourceRange Set destrange = basebook.Worksheets(1).Cells(rnum, "A"). _ Resize(.Rows.Count, .Columns.Count) End With destrange.Value = sourceRange.Value mybook.Close False rnum = rnum + SourceRcount FNames = Dir() Loop ChDrive SaveDriveDir ChDir SaveDriveDir Application.ScreenUpdating = True End Sub |
#2
|
|||
|
|||
editing macro to pull multiple cells instead of a single cell
The following revised code will pull the data from the four cells:
'===================== Sub TestFile2() Dim basebook As Workbook Dim mybook As Workbook Dim sourceRange As Range Dim destrange As Range Dim rnum As Long Dim SourceRcount As Long Dim FNames As String Dim MyPath As String Dim SaveDriveDir As String Dim c As Range 'added new variable Dim i As Integer 'added new variable SaveDriveDir = CurDir MyPath = _ "C:\Documents and Settings\rspence\Desktop\Updated Reports" ChDrive MyPath ChDir MyPath FNames = Dir("*.xls") If Len(FNames) = 0 Then MsgBox "no files in the Directory" ChDrive SaveDriveDir Exit Sub End If Application.ScreenUpdating = False Set basebook = ThisWorkbook basebook.Worksheets(1).Cells.Clear rnum = 1 Do While FNames "" Set mybook = Workbooks.Open(FNames) 'changed from here *********************** Set sourceRange = mybook.Worksheets(1).Range("B4,B6,B7,G4") SourceRcount = sourceRange.Rows.Count Set destrange = basebook.Worksheets(1).Cells(rnum, "A") i = 0 For Each c In sourceRange destrange.Offset(0, i).Value = c.Value i = i + 1 Next c 'to here ************************************** mybook.Close False rnum = rnum + SourceRcount FNames = Dir() Loop ChDrive SaveDriveDir ChDir SaveDriveDir Application.ScreenUpdating = True End Sub '======================== spence wrote: Thanks to a very helpful gentleman on these boards, I have used the below pasted code, I have created a macro that pulls the values from cell B4 in all the sheets in a folder and puts them in column A on a new sheet. I'm wondering if someone can help me edit the code so that I can pull from four non-adjacent cells and then dump into columns A-D in my new sheet. The cells in question are B4, B6, B7, and G4. -- Debra Dalgleish Excel FAQ, Tips & Book List http://www.contextures.com/tiptech.html |
Thread Tools | |
Display Modes | |
|
|