copy data from closed workbooks

FROGGER24 · Aug 27, 2009

I have a folder located at K:\abc\def\ghi\vins reports. Within that folder I have a workbook called Get data macro, using sheet1 starting in cell A2:F, I need to loop through all of the workbooks within this folder ,getting the cell values from the worksheet called VAR,cells F4,A6,D6,C13,C20,C32. This folder will contain several workbooks so the workbook name will be changing, but the sheet name will always be VAR. Thanks for any help

hiker95 · Aug 27, 2009

seeblue,

I have used the following macro on many occasions (adjusted per your request).

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Adding the Macro
1. Copy the below macro, by highlighting the macro code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel

Code:

Option Explicit
Sub GetMyData()
Dim myDir As String, fn As String, sn As String, NR As Long
myDir = "K:\abc\def\ghi\vins reports"
sn = "VAR"
fn = Dir(myDir & "\*.xls")
NR = 1
Do While fn <> ""
  If fn <> ThisWorkbook.Name Then
    With ThisWorkbook.Sheets("Sheet1")
      NR = NR + 1
      
      'worksheet called VAR,cells F4,A6,D6,C13,C20,C32.
      
      With .Range("A" & NR)
        .Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!F4"
        .Value = .Value
      End With
      With .Range("B" & NR)
        .Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!A6"
        .Value = .Value
      End With
      With .Range("C" & NR)
        .Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!D6"
        .Value = .Value
      End With
      With .Range("D" & NR)
        .Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!C13"
        .Value = .Value
      End With
      With .Range("E" & NR)
        .Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!C20"
        .Value = .Value
      End With
      With .Range("F" & NR)
        .Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!C32"
        .Value = .Value
      End With
    End With
  End If
  fn = Dir
Loop
End Sub

Then run the "GetMyData" macro.

If the above does not work correctly, then could you please supply a screenshot of one of the "VAR" sheets.

Please post a screenshot of your sheet(s), what you have and what you expect to achieve, with Excel Jeanie HTML 4 (contains graphic instructions).
http://www.excel-jeanie-html.de/html/hlp_schnell_en.php

ravishankar · Aug 29, 2009

Hi
Save the workbook with these macro codes inside the reports folder and run the macro

Code:

Sub Cblu()
Dim z  As Long, e As Long
Dim f As String, b As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Cells(1, 1) = "=cell(""filename"")"
Cells(1, 2) = "=left(A1,find(""["",A1)-1)"
Cells(3, 1).Select
f = Dir(Cells(1, 2) & "*.xls")
    Do While Len(f) > 0
    ActiveCell.Formula = f
    ActiveCell.Offset(1, 0).Select
    f = Dir()
    Loop
z = Cells(Rows.Count, 1).End(xlUp).Row
    For e = 3 To z
        If Cells(e, 1) <> ActiveWorkbook.Name Then
            For a = 1 To 6
            b = Choose(a, "F4", "A6", "D6", "C13", "C20", "C32")
              Cells(2, a + 1) = b
              Cells(1, 3) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Sheet1'!" & b
            Cells(e, a + 1) = Cells(1, 3)
            Next a
        End If
    Next e
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "collating is complete."
End Sub

Ravi

FROGGER24 · Aug 31, 2009

Thank you both for your replies. I have since learned that not all of the workbooks have a worksheet called "VAR". Would it be possible to modify the code to... if worksheet "Var" not found, look for worksheet "Load Inspection"getting values from cells E8,E9,G6,E26,E80 and placing those values in cells A-E

GTO · Aug 31, 2009

Greetings seeblue,

Given that we are now testing for the existance of one of two sheets, I think it would be easier to open the workbooks, test, get appropriate data, and close. In a throwaway copy of your wb, try:

In a Standard Module:

Option Explicit Sub exa() Dim FSO As Object '<--- FileSystemObject Dim FOL As Object '<--- Folder Dim FIL As Object '<--- File Dim wb As Workbook Dim lOpenRow As Long Dim aryVals '// Set a reference and get the folder as an object, to access the files // '// collection therein // Set FSO = CreateObject("Scripting.FileSystemObject") Set FOL = FSO.GetFolder(ThisWorkbook.Path & "\") '// Kill updating to speed up code and reduce user's awareness of opening/ // '// closing wb's // Application.ScreenUpdating = False For Each FIL In FOL.Files '// Ensure ea file is a wb (but not ThisWorkbook) before opening // If FIL.Type = "Microsoft Excel Worksheet" _ And Not FIL.Name = ThisWorkbook.Name Then Set wb = Workbooks.Open(FIL.Path) '// See if the sheet exists// If SheetExists(wb, "Var") Then '// if yes, size accordingly// ReDim aryVals(1 To 1, 1 To 6) With wb.Worksheets("Var") '// fill the array with the vals// aryVals(1, 1) = .Range("F4").Value aryVals(1, 2) = .Range("A6").Value aryVals(1, 3) = .Range("D6").Value aryVals(1, 4) = .Range("C13").Value aryVals(1, 5) = .Range("C20").Value aryVals(1, 6) = .Range("C32").Value End With '// See where the next open row is in this wb sheet1...// lOpenRow = NextRow_Ret(ThisWorkbook.Worksheets("Sheet1"), "A:F") '// ...and kaplunk the vals in// ThisWorkbook.Worksheets("Sheet1") _ .Range("A" & lOpenRow & ":F" & lOpenRow).Value = aryVals ElseIf SheetExists(wb, "Load Inspection") Then ReDim aryVals(1 To 1, 1 To 5) With wb.Worksheets("Load Inspection") aryVals(1, 1) = .Range("E8").Value aryVals(1, 2) = .Range("E9").Value aryVals(1, 3) = .Range("G6").Value aryVals(1, 4) = .Range("E26").Value aryVals(1, 5) = .Range("E80").Value End With lOpenRow = NextRow_Ret(ThisWorkbook.Worksheets("Sheet1"), "A:F") ThisWorkbook.Worksheets("Sheet1") _ .Range("A" & lOpenRow & ":E" & lOpenRow).Value = aryVals Else '// if neither sheet exists, tell user// MsgBox "Neither sheet was found in:" & vbCrLf & _ FIL.Name & vbCrLf & vbCrLf & _ "The workbook will now close", 0, "" End If wb.Close False End If Next Application.ScreenUpdating = True End Sub Function NextRow_Ret(wks As Worksheet, ColStr As String) As Long Dim rngSearch As Range Dim rngFound As Range Set rngSearch = wks.Range(ColStr) Set rngFound = rngSearch.Find(What:="*", _ After:=rngSearch(1, 1), _ LookIn:=xlValues, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ searchdirection:=xlPrevious) If rngFound Is Nothing Then NextRow_Ret = 2 Exit Function End If If rngFound.Row = 1 Then NextRow_Ret = 2 Else NextRow_Ret = rngFound.Row + 1 End If End Function Function SheetExists(wb As Workbook, ShName As String) As Boolean Dim wks As Worksheet On Error Resume Next Set wks = wb.Worksheets(ShName) On Error GoTo 0 If Not wks Is Nothing Then SheetExists = True End Function 

I believe I followed which cells' vals you wanted where, but if anything is out of order, you should be able to adjust what cells' vals are placed in which elements.

Hope that helps,

Mark

hiker95 · Sep 1, 2009

seeblue,

I am assuming that there is always data in the following cells, for the respective worksheets:

worksheet called VAR,cells F4,A6,D6,C13,C20,C32

and,

worksheet "Load Inspection"getting values from cells E8,E9,G6,E26,E80

The new macro code has been tested in my environment with two workbooks:
seeblueLI.xls
seeblueVAR.xls

Before the updated macro:

Excel Workbook

A

B

C

D

E

F

1

2

3

4

Sheet1

After the updated macro:

Excel Workbook

A

B

C

D

E

F

1

2

LI E8

LI E9

LI G6

LI E26

LI E80

3

VAR F4

VAR A6

VAR D6

VAR C13

VAR C20

VAR C32

4

Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Code:

Option Explicit
Sub GetMyData()

Dim myDir As String, fn As String, sn As String, sn2 As String, NR As Long

myDir = "K:\abc\def\ghi\vins reports"

sn = "VAR"
sn2 = "Load Inspection"
fn = Dir(myDir & "\*.xls")
NR = 1
Do While fn <> ""
  If fn <> ThisWorkbook.Name Then
    With ThisWorkbook.Sheets("Sheet1")
      NR = NR + 1
      
      With .Range("A" & NR)
        .Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!F4"
        .Value = .Value
      End With
      
      If .Range("A" & NR) = 0 Then GoTo ErrorVar
      
      With .Range("B" & NR)
        .Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!A6"
        .Value = .Value
      End With
      With .Range("C" & NR)
        .Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!D6"
        .Value = .Value
      End With
      With .Range("D" & NR)
        .Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!C13"
        .Value = .Value
      End With
      With .Range("E" & NR)
        .Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!C20"
        .Value = .Value
      End With
      With .Range("F" & NR)
        .Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!C32"
        .Value = .Value
      End With

      GoTo ErrorVarContinue

ErrorVar:
      
      With .Range("A" & NR)
        .Formula = "='" & myDir & "\[" & fn & "]" & sn2 & "'!E8"
        .Value = .Value
      End With
      With .Range("B" & NR)
        .Formula = "='" & myDir & "\[" & fn & "]" & sn2 & "'!E9"
        .Value = .Value
      End With
      With .Range("C" & NR)
        .Formula = "='" & myDir & "\[" & fn & "]" & sn2 & "'!G6"
        .Value = .Value
      End With
      With .Range("D" & NR)
        .Formula = "='" & myDir & "\[" & fn & "]" & sn2 & "'!E26"
        .Value = .Value
      End With
      With .Range("E" & NR)
        .Formula = "='" & myDir & "\[" & fn & "]" & sn2 & "'!E80"
        .Value = .Value
      End With

ErrorVarContinue:

    End With
  End If
  fn = Dir
Loop
End Sub

Then run the updated "GetMyData" macro.

hiker95 · Sep 1, 2009

seeblue,

If would help to see your data.

Please supply a screenshot of one of the "VAR", and, one of the "Load Inspection" sheets.

For sheet "Load Inspection" only display cells E8,E9,G6,E26.

Please post a screenshot of your sheet(s), what you have and what you expect to achieve, with Excel Jeanie HTML 4 (contains graphic instructions).
http://www.excel-jeanie-html.de/html/hlp_schnell_en.php

copy data from closed workbooks

FROGGER24

Well-known Member

Excel Facts

hiker95

Well-known Member

ravishankar

Well-known Member

FROGGER24

Well-known Member

GTO

MrExcel MVP

hiker95

Well-known Member

hiker95

Well-known Member

Similar threads

Forum statistics

Share this page

copy data from closed workbooks

FROGGER24

Well-known Member

Excel Facts

hiker95

Well-known Member

ravishankar

Well-known Member

FROGGER24

Well-known Member

GTO

MrExcel MVP

hiker95

Well-known Member

hiker95

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock