LinkBack URL
About LinkBacksI finally figured out a way to extract data from all workbooks contained in
one folder. The data being extracted is composed in one column (column b x 26
rows), extracted from 50 files (one for each state). I need this data to be
put into a basebook as rows (transposed) so that for each state abbreviation,
all data will appear to the right of the state (the first row of column b is
the state abbreviation) . I know there is a way to pull in the data so that
it is showing 26 columns with all the data placed directly under these
columns (so 50 rows will be shown, one for each state). I just don't know how
to manipulate the vba accordingly.
As of now, it just pulls everything one block at a time, and now I have
50x26 rows...
Here is how I am pulling the data now:
Sub Example1()
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:\!Data\Data Collection"
ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If
Application.ScreenUpdating = False
Set basebook = ThisWorkbook
basebook.Worksheets("Sheet1").Cells.Clear
rnum = 1
Do While FNames <> ""
Set mybook = Workbooks.Open(FNames, Password:="chris",
WriteResPassword:="chris", UpdateLinks:=0)
Set sourceRange = mybook.Worksheets("Please Complete
(Medical)").Range("C6:C31")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets("Sheet1").Cells(rnum, "A")
basebook.Worksheets("Sheet1").Cells(rnum, "D").Value = mybook.Name
sourceRange.Copy destrange
mybook.Close False
rnum = rnum + SourceRcount
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub
Need only 50 rows.
Someone please help...!
Register To Reply
Bookmarks