我需要将多个电子表格中的多个单元格复制到基于Excel中第三个单元格内容的摘要表中

Question

I need to copy the contents of cells A2 to A88 and C2 to C88 based on the contents of what is in cells in column G from several spreadsheets in a workbook to the Summary sheet.

So I need code to scan all spreadsheets to see if the word Case closed is in cell G33 and than copy the contents of cell A33 and C33 to a cell on the summary page.

I have seen several close answers but nothing that does the job.

Sorry no code available.

Thanks for any and all answers.

Answer 1

You could create some vba if you cannot solve this using excel formulas... I made a little test excel sheet with following vba code:

Sub test()
    processSheet Application.ActiveWorkbook, "Sheet1"
End Sub

Function FindSheet(currentWorkbook As Workbook, sheetName As String) As Worksheet
    If currentWorkbook Is Nothing Then
        Err.Raise vbObjectError + 1, "FindSheet", "Supplied workbook is nothing"
    End If
    Dim idx As Integer
    For idx = 1 To currentWorkbook.Sheets.Count
        Dim checkSheet As Worksheet
        Set checkSheet = currentWorkbook.Sheets.Item(idx)
        If checkSheet.Name = sheetName Then
            Set FindSheet = checkSheet
            Exit Function
        End If
    Next
End Function

Function IsEmpty(currentCell As Range) As Boolean
    IsEmpty = False
    If currentCell.Value = "" And currentCell.Value2 = "" Then
        IsEmpty = True
    End If
End Function

Sub processSheet(currentWorkbook As Workbook, sheetName As String)
    On Error GoTo Catch
    Dim currentSheet As Worksheet
    Set currentSheet = FindSheet(currentWorkbook, sheetName)
    If currentSheet Is Nothing Then
        Err.Raise vbObjectError + 2, "ProcessSheet", "Could not find sheet " + sheetName
    End If
    Dim colA As Range
    Dim colB As Range
    Dim colCondition As Range
    Dim colResult As Range

    currentSheet.Activate

    Set colA = currentSheet.Columns(1)
    Set colB = currentSheet.Columns(2)
    Set colCondition = currentSheet.Columns(3)
    Set colResult = currentSheet.Columns(4)

    Dim index As Integer: index = 2
    Dim run As Boolean: run = True

    Do While run
        If IsEmpty(colA.Rows(index)) And IsEmpty(colB.Rows(index)) And IsEmpty(colCondition.Rows(index)) Then
            run = False
        Else
            index = index + 1
            If colCondition.Rows(index).Value = "Closed" Then
                resultContent = CStr(colA.Rows(index).Value2) + ": " + CStr(colB.Rows(index).Value2)
            Else
                resultContent = "-"
            End If
            colResult.Rows(index).Value2 = resultContent
        End If
    Loop
    GoTo Finally

Catch:
        MsgBox ("An error occured: " + Err.Description)
        Exit Sub
Finally:

    End Sub

You can just put this macro in the macros of a new workbook. Open the Sheet1 and add 4 columns. I added a screenshot of how the excel sheet looks like.

As a new user I'm not allowed to post images.. so here is the link: Sheet1

Short explanation of the code.

• A workbook is passed and a sheet selected by a sheet name
• If the sheet is available the script runs through the three dependent columns (two columns needed for concatenation and one for the condition) and checks if the values are set. The loop stops when all the three columns do not contain any value (in your case you could hardcode the start and end index, if it always stays the same).
• During the iteration, the condition field is checked. If it is equals "Closed", the result cell is filled with the first two columns values concatenated.

You certainly need to adapt the code to your problem, but shouldn't be a big thing to do.