Results 1 to 8 of 8
  1. #1
    2 Star Lounger
    Join Date
    Jan 2007
    Location
    Gray, Louisiana, USA
    Posts
    289
    Thanks
    0
    Thanked 0 Times in 0 Posts
    I need a macro,'I think?'

    That can look on a Drive and return the VALUES of a column on a, SPECIFIED SHEET, in a workbook to THE OPEN workbook say column D

    The path would be similar to : I/Folder/subfolder/-------Then I would like to choose the workbook and have the values in a specified column (manually selected or automated) doumload to the open workbook.

    Ok - I think I repeated myself.

    I don't know how to do this.

    Any help or code is greatly appreciated.

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    Why do you need a macro for this? You can open the workbook, copy data in a column and paste them into the other workbook.

  3. #3
    2 Star Lounger
    Join Date
    Jan 2007
    Location
    Gray, Louisiana, USA
    Posts
    289
    Thanks
    0
    Thanked 0 Times in 0 Posts
    I would like to be able to loop through all the workbooks in a directory.

  4. #4
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    Use this macro as starting point:

    Code:
    Sub ImportColumns()
      ' These constants are just examples
      ' Modify them as needed
      Const strSheetName = "Data" ' Name of the sheet you want to import from
      Const lngInCol = 5 ' Import from column E
      Const lngOutCol = 8 ' Copy to column H
      Const strPath = "C:\Test\" ' Path of the workbooks with trailing backslash
    
      Dim wbkIn As Workbook
      Dim wshIn As Worksheet
      Dim wshOut As Worksheet
      Dim strFile As String
      Dim lngMaxInRow As Long
      Dim rngLastOut As Range
    
      Set wshOut = ActiveSheet
      strFile = Dir(strPath & "*.xls")
      Do While Not strFile = ""
    	Set wbkIn = Workbooks.Open(strPath & strFile)
    	Set wshIn = wbkIn.Worksheets(strSheetName)
    	lngMaxInRow = wshIn.Cells(wshIn.Rows.Count, lngInCol).End(xlUp).Row
    	Set rngLastOut = wshOut.Cells(wshOut.Rows.Count, lngOutCol).End(xlUp)
    	wshIn.Range(wshIn.Cells(1, lngInCol), _
    	  wshIn.Cells(lngMaxInRow, lngInCol)).Copy _
    	  Destination:=rngLastOut.Offset(1, 0)
    	wbkIn.Close SaveChanges:=False
    	strFile = Dir
      Loop
    End Sub
    Modify it to suit your needs.

  5. #5
    2 Star Lounger
    Join Date
    Jan 2007
    Location
    Gray, Louisiana, USA
    Posts
    289
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Thankyou-Very well explained!

    Questions
    The column(s) I am importing from the different sheets contain formulas, How can I modify the code to extract the values-which are dates by the way.

    also
    The data extracts down one column, as the code directs it to do. Can each worksheet extraction be placed side by side say column c,d,e,f,g, etc. when it is imported into the blank workbook? I have it extracting to column C right now.

  6. #6
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    Try this version:

    Code:
    Sub ImportColumns()
      ' These constants are just examples
      ' Modify them as needed
      Const strSheetName = "Data" ' Name of the sheet you want to import from
      Const lngInCol = 5 ' Import from column E
      Const strPath = "C:\Test\" ' Path of the workbooks with trailing backslash
    
      Dim wbkIn As Workbook
      Dim wshIn As Worksheet
      Dim wshOut As Worksheet
      Dim strFile As String
      Dim lngMaxInRow As Long
      Dim lngOutCol As Long
    
      Set wshOut = ActiveSheet
      strFile = Dir(strPath & "*.xls")
      lngOutCol = 3 ' Start copying at column C
      Do While Not strFile = ""
    	Set wbkIn = Workbooks.Open(strPath & strFile)
    	Set wshIn = wbkIn.Worksheets(strSheetName)
    	lngMaxInRow = wshIn.Cells(wshIn.Rows.Count, lngInCol).End(xlUp).Row
    	' Copy column
    	wshIn.Range(wshIn.Cells(1, lngInCol), _
    	  wshIn.Cells(lngMaxInRow, lngInCol)).Copy
    	' Paste values and number formats
    	wshOut.Cells(1, lngOutCol).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    	wbkIn.Close SaveChanges:=False
    	' Increase column number for next file
    	lngOutCol = lngOutCol + 1
    	strFile = Dir
      Loop
    End Sub

  7. #7
    2 Star Lounger
    Join Date
    Jan 2007
    Location
    Gray, Louisiana, USA
    Posts
    289
    Thanks
    0
    Thanked 0 Times in 0 Posts
    I get a runtime error 52 with the cursor blinking at the line with the red arrow.
    Attached Images Attached Images

  8. #8
    2 Star Lounger
    Join Date
    Jan 2007
    Location
    Gray, Louisiana, USA
    Posts
    289
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Found the problem, it all works fine thanks.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •