Need help compiling data from other wooksheets

[simondrew]

Need help.

I have 5 sheets in 1 wookbook with about 15 columns of varying rows of data. What I need to do is create a macro which collates all the rows of data, which with their own heading, onto 1 sheet so that it can be printed and distributed.

The problem is of course is that normal copy and paste won't work because the rows may vary and the macro need to take that into consideration. I guess probably an 'If not or' type command that would copy and paste the row so long as it had values then move onto the next sheet and continue from the last one.

Thanks in advance.
Simon.

 

[Thebatfink]

Hi,

I would like to use this code to create a listing of more specific data taken from a folder of workbooks.

Sub test() 
Dim myDir As String, fn As String, ws As Worksheet 
myDir = "C:\test\" 
fn = Dir(myDir & "*.xls") 
If fn = "" Then Exit Sub 
Do While fn <> "" 
     Set ws = Workbooks.Open(myDir & fn).Sheets(1) 
     ws.Range("a7", ws.Range("a" & Rows.Count).End(xlUp)).EntireRow.Copy 
     ThisWorkbook.Sheets(1).Range("a" & Rows.Count).End(xlUp).Offset(1) 
     Workbooks(fn).Close False 
     fn = Dir 
Loop 
End Sub

Working from the original suggested code, what do I need to modify to perform the following task..?

For example I want to take cell A1 from each workbook and list these down column A of my consolidation workbook. I then want to take cell B6 from each workbook and list these down column B of my consolidation workbook, and so on and so on.

Obviously I want each row of the consolidation workbook to show information from the same workbook if you get my meaning.

In my consolidaiton workbook, A1 B1 C1 will be cells from book1.xls A1 B6 C10, A2 B2 C2 in my consolidation workbook will be cells from book2.xls A1 B6 C10. Sorry for over explaining if it you already understood!!

Many thanks!

 

[jindon]

In my consolidaiton workbook, A1 B1 C1 will be cells from book1.xls A1 B6 C10, A2 B2 C2 in my consolidation workbook will be cells from book2.xls A1 B6 C10. Sorry for over explaining if it you already understood!!

Much better than less and explanation that is not understandable.

Sub test() 
Dim myDir As String, fn As String, ws As Worksheet 
myDir = "C:\test\" 
fn = Dir(myDir & "*.xls") 
If fn = "" Then Exit Sub 
Do While fn <> "" 
     Set ws = Workbooks.Open(myDir & fn).Sheets(1)  
     ThisWorkbook.Sheets(1).Range("a" & Rows.Count).End(xlUp).Offset(1) .Resize(,4).Value = _
     Array(ws.Range("a1").Value, ws.Range("b6").Value, ws.Range("c10").Value, fn & "-" & ws.Name)
     Workbooks(fn).Close False 
     fn = Dir 
Loop 
End Sub

If you have common sheet name in each file, then you don't need to open.

Sub test() 
Dim myDir As String, fn As String, ws As Worksheet
Fim WsName As String, myFormula As String
WsName = "Sheet1"  '<- need to be changed
myDir = "C:\test\" 
fn = Dir(myDir & "*.xls") 
If fn = "" Then Exit Sub 
Do While fn <> ""  
     myFormula = "='" & myDir & "[" & fn & "]" & WsName & "'!"
     With ThisWorkbook.Sheets(1).Range("a" & Rows.Count).End(xlUp).Offset(1) .Resize(,4)
        .Formula = Array(myFormula & "A1", myFormula & "B6", myFormula & "C10", fn & "-" & WsName)
        .Value = .Value
    End With
     fn = Dir 
Loop 
End Sub

 

[hu8mypho]

thank you, I didn't realize at the time at it was merely another option of the paste special. I will use this for sure.

On another note to make it a bit more "stream-line"

I have a template (xlt) that would be used to gather the data in these spreadsheets. One thing is that there are several different revisions, but some people may not be using the correct version.

The reason for this is as I pull in the data, I will be looking up this data and it will then split out data accordingly as needed. So I would need to be assured that I am copying the right oncents into the proper cells.

Can I add a checker "value" [file1]sheet1!A1=V2.3, etc... before doing copy paste, else >> error , etc.. ?

Thanks again for your help.

 

[jindon]

Can I add a checker "value" [file1]sheet1!A1=V2.3, etc... before doing copy paste, else >> error , etc.. ?

Sub test() 
Dim myDir As String, fn As String, ws As Worksheet 
Fim WsName As String, myFormula As String 
WsName = "Sheet1"  '<- need to be changed 
myDir = "C:\test\" 
fn = Dir(myDir & "*.xls") 
If fn = "" Then Exit Sub 
Do While fn <> ""  
     myFormula = "'" & myDir & "[" & fn & "]" & WsName & "'!" 
     If ExecuteExcel4Macro(myFormula & "R1C1") <> "V2.3" Then
         ThisWorkbook.Sheets(1).Range("a" & Rows.Count).End(xlUp)) _
              .Offset(1).Resize(,2).Value = Array("Erorr", fn)
     Else
         myFormula = "=" & myFormula
         With ThisWorkbook.Sheets(1).Range("a" & Rows.Count).End(xlUp) _
            .Offset(1) .Resize(,4) 
            .Formula = Array(myFormula & "A1", myFormula & "B6", _
                             myFormula & "C10", fn & "-" & WsName) 
            .Value = .Value 
         End With 
    End If
    fn = Dir 
Loop 
End Sub

 

[Thebatfink]

Hi, thanks for the altered code! Much appreciated.

I have entered this into the sheet (and added the specific cells I'm after it collecting into the collation sheet) but I am getting an error.

When stepping through it errors at this line with the following error-

run-time error'1004':
Application-defined or object-defined error

  Set ws = Workbooks.Open(myDir & fn).Sheets(1)

Here is the code I have in my sheet..

 Sub test()
Dim myDir As String, fn As String, ws As Worksheet
myDir = "U:\SOC TEST SHEET\soc"
fn = Dir(myDir & "*.xls")
If fn = "" Then Exit Sub
Do While fn <> ""
     Set ws = Workbooks.Open(myDir & fn).Sheets(1)
     ThisWorkbook.Sheets(1).Range("a8" & Rows.Count).End(xlUp).Offset(1).Resize(, 4).Value _
     Array(ws.Range("r1").Value, ws.Range("v1").Value, ws.Range("d60").Value, ws.Range("v2").Value, ws.Range("g5").Value, ws.Range("f14").Value, ws.Range("f16").Value, ws.Range("f15").Value, ws.Range("r15").Value, ws.Range("r16").Value, fn & "-" & ws.Name)
     Workbooks(fn).Close False
     fn = Dir
Loop
End Sub

Why is it doing this?

 

[jindon]

You missed the path separator at the end

myDir = "U:\SOC TEST SHEET\soc\"

 

[Thebatfink]

Oops, didn't spot that. Thanks, it works very nicely now! I love it )

I am however having a different issue!! Whilst my code works, I'm trying to find a way of accessing a folder on a network drive which doesn't have the drive letter assigned the same actual letter on each machine.

Basically the path I am trying to access is for example:

S:\folder1\folder2\folder3\

But for some people it is

Z:\folder1\folder2\folder3\

Now, they all however access the spreadsheet from the same place, which is in "folder2" of the drive. So I thought I could use the following to just search a folder within the current home folder of the spreadsheet. I think it "was" working, but it's suddenly stopped and I don't know why, maybe there is something wrong with this code??

Private Sub UpdateUdOnlyButton_Click()
Dim myDir As String, fn As String, ws As Worksheet
myDir = ".\folder3\"
fn = Dir(myDir & "*.xls")
If fn = "" Then Exit Sub
Sheet5.Unprotect Password:="password"
Sheet5.Range("A6:J3000").ClearContents
Application.ScreenUpdating = False
Do While fn <> ""
     Set ws = Workbooks.Open(myDir & fn).Sheets(1)
     Sheet5.Range("a" & Rows.Count).End(xlUp).Offset(1).Resize(, 10).Value = _
     Array(ws.Range("r1").Value, ws.Range("v1").Value, ws.Range("d60").Value, ws.Range("v2").Value, ws.Range("g5").Value, ws.Range("f14").Value, ws.Range("f16").Value, ws.Range("f15").Value, ws.Range("r15").Value, ws.Range("r16").Value, fn & "-" & ws.Name)
     Workbooks(fn).Close False
     fn = Dir
Loop
Sheet5.Range("i3").Value = Date
Sheet5.Protect Password:="password"
Application.ScreenUpdating = True
ActiveWorkbook.SaveAs Filename:="listings.xls"
End Sub

Is there something incorrect here that I'm not spotting? Thanks!

 

[jindon]

Don't use mapped drive name.
If you cna find out network address like "\\server\folder1\foler2", then you can change CurDir with Shell.