excel - copying between sheets in macro

[Lee_S]

I have a workbook of sheets that contain data and then also a reports sheet which i want to use to pull data from the other sheets and list it.

So, the idea is to scan through column E in each sheet and where the cell is empty copy the entire row to the next line available on the reports sheet.

This sorta works, but only when 'reports' isnt the active sheet, and then it lists all the other rows after the needed ones. This probably isnt the best way to do it, is there a better way so that it doesnt matter which sheet is active? I'd quite like to put this into a button macro on the reports sheet.

Code so far:

Sub Show_Outstanding()
Dim ws As Worksheet
Dim rng As Range
Dim lLastRow As Integer
Dim lLastCol As Integer
Dim x As Integer
 
    For Each ws In Worksheets
        If ws.Name <> "Reports" Then
            Set rng = Worksheets(ws.Name).Range("A1").SpecialCells(xlCellTypeLastCell)
            lLastRow = rng.Row
            lLastCol = rng.Column
            
            For x = 2 To lLastRow
                If Cells(x, "E") = "" Then
         
                Worksheets("Reports").Rows(FindBottomRow("Reports", 1)).Value = Worksheets(ws.Name).Rows(x).Value
         
                End If
            Next x
        End If
    Next
End Sub

[NeedSomeAnswers]

Hi Lee, i have adapted some of my own code to do what you want, i haven't tested it so you will need too, but it should work!

'Assumes Summary Sheet is Sheet 1
 
Dim i As Integer         'needs to be declared at top of module
Dim n as Integer
 
i = 1
 
For n = 2 To Worksheets.Count                       ' add to your sub
    Calc_Summary 1, n, Worksheets(n).Name
Next
 
 
Public Sub Calc_Summary(IntSummary As Integer,n As Integer, SheetName As String)
 
Dim strRange As String
Dim SaveRange As String
Dim CellVal As String
Dim Count As Long
Dim max As Long
Dim max2 As Long
Dim SaveRange As String
Dim j As Integer 
 
'****
 
max2 = Worksheets(n).Range("E1").End(xlDown).Row        'Max Row for Worksheet being parsed ! - you may need to declare a range on the worksheet as this may not calculate properly with spaces in the column !
 
j = 1
 
strRange = SheetName & "!E1:E" & max2               'Range for Worksheet being parsed !
 
    For Each cell In Range(strRange)                'Loops through Column E for the current spreadsheet 
        CellVal = cell.Value
        If CellVal = "" then
                Worksheets(IntSummary).Rows(i & ":" & i).Select = Worksheets(SheetName).Rows(j & ":" & j)
                i = i + 1
        End If
    j = j + 1 
 
    Next
 
End Sub

[Webtest]

This sorta works, but only when 'reports' isnt the active sheet, and then it lists all the other rows after the needed ones. This probably isnt the best way to do it, is there a better way so that it doesnt matter which sheet is active? I'd quite like to put this into a button macro on the reports sheet.

(Snippets)

For Each ws In Worksheets
        If ws.Name <> "Reports" Then
            Set rng = Worksheets(ws.Name).Range("A1").SpecialCells(xlCellTypeLastCell)
                ...
                Worksheets("Reports").Rows(FindBottomRow("Reports", 1)).Value = Worksheets(ws.Name).Rows(x).Value

Try using 'handles' for the two sheets you are currently using ... "ws" is already a handle for the current data sheet. Do something like the following:

dim sht_Rpt as Worksheet  'Set a handle for the Reports Sheet
Set sht_Rpt = Sheets("Reports")

' Change the following:
            Set rng = Worksheets(ws.Name).Range("A1").SpecialCells(xlCellTypeLastCell)
' To something like the following:
            Set rng = ws.Range("A1").SpecialCells(xlCellTypeLastCell)
'
' Change the following:
                Worksheets("Reports").Rows(FindBottomRow("Reports", 1)).Value = Worksheets(ws.Name).Rows(x).Value
' To something like the following:
                sht_Rpt.Rows(FindBottomRow("Reports", 1)).Value = ws.Rows(x).Value

In any case, you seem to be using "Worksheets(sheetname)" where I think you should be using "Sheets(sheetname)" to specify a particular sheet. "ws" identifies the current datasheet, and if you add the handle I suggest above, "sht_Rpt" identifies the "Reports" sheet.

Some functions only work on the active sheet currently in the display window. Check for that.

Work with it a little and post back again. I hope this helps.

[Webtest]

Also, I think:

If Cells(x, "E") = "" Then

Should be something like:

If ws.Cells(x, 5) = "" Then

P.S.
The "E" works in Cells ... I never knew that! I've always converted it to a number!

[Lee_S]

Brilliant, thanks for the help guys. It really helped and now i'm a step further along. However I have another couple of problems to sort out.

How can i get it to clear the Reports sheet of all cell contents and formatting EXCEPT the first couple of rows where headers etc are? This is so that fresh data is always shown, rather than adding to the bottom of the sheet.

Another problem, is that when i copy a cell with a date in it goes from dd/mm/yy to mm/dd/yy and I cant figure out how to stop it. Changing the cell properties doesnt seem to work.

This is the code so far..

Sub Show_Outstanding()
Dim rng As Range
Dim lLastRow As Integer
Dim x As Integer
Dim bFound As Boolean

Dim ws As Worksheet
Dim sht_Rpt As Worksheet  'Set a handle for the Reports Sheet
Set sht_Rpt = Sheets("Reports")

    bFound = False
    For Each ws In Worksheets
        If ws.Name <> "Reports" Then
            Set rng = ws.Range("A1").SpecialCells(xlCellTypeLastCell)
            lLastRow = rng.Row
            
            For x = 2 To lLastRow 'First two rows contain headers etc
                If ws.Cells(x, "E").Value = "" And ws.Cells(x, "E").Interior.ColorIndex = xlAutomatic Then
                    If bFound = False Then
                        bFound = True
                        With sht_Rpt.Cells(FindBottomRow(sht_Rpt, 1), "A")
                            .Value = ws.Name
                            .Font.Bold = True
                        End With
                    End If
                    sht_Rpt.Rows(FindBottomRow(sht_Rpt, 1)).Value = ws.Rows(x).Value
                End If
            Next x
        End If
        bFound = False
    Next
End Sub

Function FindBottomRow(WhatSheet As Worksheet, WhatColumn As Long) As Long
Dim R As Long
   R = WhatSheet.Cells(65534, WhatColumn).End(xlUp).Row
   If Len(WhatSheet.Cells(R, WhatColumn).Text) Then R = R + 1
   FindBottomRow = R
End Function

[Webtest]

I hope you find someone who knows the elegant way involving (I think it is called "Regional Settings"), but in the mean time you can 'brute force' it by setting a range object to the range of cells and doing the following:

Range(Cells(1,3),Cells(1,7)).NumberFormat = "dd/mm/yy"

Check Regional Options, Regional and Language Settings, etc.

You might start a new thread regarding just this topic.

[Webtest]

There are various ways to clear out all but the header rows. Here are a couple of them ... I haven't tried any of them so I don't have specific code.

Copy the header rows ... I'm pretty sure they go to the clipboard. Clear the entire sheet, and then paste the headers back. You can test this by recording a macro to do that. It will give you a template for your code.

Here's a good one!
Rows("3:65536").Delete Shift:=xlUp
It doesn't take but a split second to run.

Insert a new blank sheet into the workbook. Copy the headers into the new sheet. Rename the old sheet tab slightly, and assign the old name to the new sheet. Delete the old sheet. I don't really like this way though, because you loose a lot ... Print settings, formatting, column widths, etc. Try my first suggestion first.

Good Learning and Good Programming!