Copy data from multiple rows only if data exists.

Question

I have a spreadsheet named "Data Sheet" that collects data from other worksheets via formulas and works perfectly. I need a macro that will copy the data from multiple rows so I can paste into a seperate workbook. I have 30 rows of data ranging from A3:EI3 to A32:EI32. This data is collected from 1 to 30 other sheets if they are made visible and data entered. Here is the tricky part. I only want to collect the data from the visible sheets. Here is an example of the flow I am looking for. "Sheet 1" is always visible and never is hidden, "Sheet 2", "Sheet 3", "Sheet 4" are visible but "Sheet 5" through "Sheet 30" are still hidden. "Data Sheet" has already collected the data from the visible sheets, but the remaining rows (Sheets 5-30) all show "0" in the data cells. I now want to run a macro that will copy the data (to the clipboard) from "Data Sheet" row 3 (represents Sheet 1), row 4 (represents "Sheet 2"), etc and allow me to paste into the next available row in another workbook. Here is the code that works for a single row of data. Thanks in advance for your expertise. VBA Code:

Sub CopyDataSheet()
'
' CopyDataSheet Macro

'
Application.ScreenUpdating = False
Sheets("Data Sheet").Visible = True


Sheets("Data Sheet").Select
Rows("3:3").Select
Selection.Copy
Rows("1:1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("E1:EF1").Select
Application.CutCopyMode = False
Selection.NumberFormat = "0"
Rows("1:1").Select
Range("B1").Activate
Selection.Copy
Sheets("Sheet 1").Select
Range("a38").Select

Sheets("Data Sheet").Visible = True

Application.ScreenUpdating = True

  MsgBox "YOU HAVE CAPTURED ALL ENTERED DATA..." & _
vbCrLf & vbCrLf & "CLICK OK" _
& vbCrLf & vbCrLf & "PASTE INTO NEXT EMPTY LINE OF DATA SHEET", _
    vbInformation, ""
End Subenter code here

Answer 1

Option Explicit

Public Sub CollectData()
    Dim wsCrnt As Excel.Worksheet
    Dim wsDest As Excel.Worksheet
    Dim lRowCrnt As Long
    Dim lRowDest As Long
    On Error GoTo Err_Hnd
    ToggleInterface False
    Set wsDest = ThisWorkbook.Worksheets("Data Sheet")
    lRowDest = wsDest.UsedRange.Rows.Count + 1&
    For Each wsCrnt In ThisWorkbook.Worksheets
        If wsCrnt.Visible = xlSheetVisible Then
            If Not wsCrnt Is wsDest Then
                For lRowCrnt = 1& To 30&
                    If Excel.WorksheetFunction.CountA(wsCrnt.Rows(lRowCrnt)) Then
                        wsCrnt.Rows(lRowCrnt).Copy
                        wsDest.Rows(lRowDest).PasteSpecial xlPasteValues
                        lRowDest = lRowDest + 1
                    End If
                Next
            End If
        End If
    Next
Exit_Proc:
    On Error Resume Next
    ToggleInterface True
    Exit Sub
Err_Hnd:
    MsgBox Err.Description, vbCritical Or vbMsgBoxHelpButton, _
        "Error: " & Err.Number, Err.HelpFile, Err.HelpContext
    Resume Exit_Proc
End Sub

Private Sub ToggleInterface(ByVal interfaceOn As Boolean)
    With Excel.Application
        .Cursor = IIf(interfaceOn, xlDefault, xlWait)
        .StatusBar = IIf(interfaceOn, False, "Working...")
        .EnableEvents = interfaceOn
        .Calculation = IIf(interfaceOn, xlCalculationAutomatic, xlCalculationManual)
        .ScreenUpdating = interfaceOn
        .EnableCancelKey = Abs(interfaceOn)
    End With
End Sub

Answer 2

Hi,

I'm not 100% sure what it is you are trying to do, but I think I can supply a few code fragments that may help you.

This will cycle through the sheets in an active workbook and allow you to do something based on whether or not the sheet is visible:

j = ActiveWorkbook.Sheets.Count

For i = 1 To j
  Select Case Sheets(i).Visible
    Case xlSheetVisible
      'Do something if the sheet is visible
    Case Else
      'Do something when the sheet is not visible
  End Select
Next i

To get the next available row there are many different ways. One of the easiest is simply this:

next_row = Range("A" & Rows.Count).End(xlUp).row + 1

This assumes that column A will always have a value in any data rows. If this is not the case you may want to try this:

next_row = ActiveSheet.UsedRange.Rows.Count + 1

Neither is bullet proof, but it should at least give you a start.