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.

 

[TiffanyG]

Sub test()
Dim myDir As String, fn As String, ws As Worksheet
myDir = "C:\test\" 'can I put multiple files here or copy code for each file?
fn = Dir(myDir & "*.xls")
If fn = "" Then Exit Sub
Do While fn <> ""
Set ws = Workbooks.Open(myDir & fn).Sheets(1) 'is this where I change the name of my sheet?
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[/code]

Just a few questions. Thanks for helping

 

[jindon]

1) if the files are in the same foloder("c:\test\" in the example), the code will open all the .xls files in turn

2) if you have any specific common sheet name in all the files, yes you can change the sheet name/index.

 

[TiffanyG]

Thanks, I'll try it tomorrow.

Tiffanyg

 

[cstlaurent]

This is exactly what I need. The only problem is I get an error:

Object doesn't support this property or method (Error 438)

The line that Is creating this error is :

ThisWorkbook.Sheets(1).Range("a" & Rows.Count).End(xlUp).Offset (1)

------
Am I missing a reference or it is a typing error. I can't seem to figure it out.

Thanks in advance..

Chris

 

[jindon]

     ws.Range("a7", ws.Range("a" & Rows.Count).End(xlUp)).EntireRow.Copy 
     ThisWorkbook.Sheets(1).Range("a" & Rows.Count).End(xlUp).Offset(1)

1) Above lines should be in the same line

ws.Range("a7", ws.Range("a" & Rows.Count).End(xlUp)).EntireRow.Copy _
ThisWorkbook.Sheets(1).Range("a" & Rows.Count).End(xlUp).Offset(1)

2) or leave it as it is and add .PasteSpecial at the end of the 2nd line

ws.Range("a7", ws.Range("a" & Rows.Count).End(xlUp)).EntireRow.Copy
ThisWorkbook.Sheets(1).Range("a" & Rows.Count).End(xlUp).Offset(1).PasteSpecial

 

[jearl97]

Wow! Great code!
Could I change this code to only pull from visible sheets? Is this possible? I have 24 sheets named "hr00" through "hr23" that I would like to pull info from into one sheet. But there are 2 other sheets in my workbook that stay hidden - I dont want them to be included in the Consolidated sheet.

Sub consolidate()
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Sheets("ConsolidatedData").Delete
Sheets.Add before:=Sheets(1)
Sheets(1).Name = "ConsolidatedData"
Dim ii As Long
For ii = 2 To Sheets.Count
   Sheets(ii).Range("A1:AA1000").Copy  'change the range to copy
     With Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        .PasteSpecial xlValues
    End With
Next ii
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Range("a1").Activate
End Sub

 

[jindon]

try

Sub test() 
Dim myDir As String, fn As String, ws As Worksheet 
myDir = "C:\test\"  'can I put multiple files here or copy code for each file?
fn = Dir(myDir & "*.xls") 
If fn = "" Then Exit Sub 
Do While fn <> "" 
     With Workbooks.Open(myDir & fn)
          For Each ws In .Sheets
               If ws.Name Like "hr*" And ws.Visible = True Then
                    ws.Range("a7", ws.Range("a" & Rows.Count).End(xlUp)).EntireRow.Copy _
                    ThisWorkbook.Sheets(1).Range("a" & Rows.Count).End(xlUp).Offset(1) 
               End If
          Next
          .Close False
     End With 
     fn = Dir 
Loop 
End Sub

 

[irn]

hi -

Welcome to the board. you can try this code.

Sub consolidate()
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Sheets("ConsolidatedData").Delete
Sheets.Add before:=Sheets(1)
Sheets(1).Name = "ConsolidatedData"
Dim ii As Long
For ii = 2 To Sheets.Count
   Sheets(ii).Range("A1:AA1000").Copy  'change the range to copy
     With Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        .PasteSpecial xlValues
    End With
Next ii
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Range("a1").Activate
End Sub

How do I use this code and exclude copying from sheet named "Entry" and "User"?

 

[hu8mypho]

This is great stuff that I can defintely re-use, however, I need to "transpose" my data, as am trying to copy a column from a worksheet out of multiple spreadsheet so that I can get a importable flat file like repository. And if at all possible be able to input into a template file with specific columns already but, that might be asking to much, I just need the most important piece to work right now. Any suggestions please?

 

[jindon]

I need to "transpose" my data, as am trying to copy a column from a worksheet out of multiple spreadsheet so that I can get a importable flat file like repository

change

                    ws.Range("a7", ws.Range("a" & Rows.Count).End(xlUp)).EntireRow.Copy _ 
                    ThisWorkbook.Sheets(1).Range("a" & Rows.Count).End(xlUp).Offset(1)

to

                    ws.Range("a7", ws.Range("a" & Rows.Count).End(xlUp)).EntireRow.Copy
                    ThisWorkbook.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Offset(,1).PasteSpecial Transpose:=True