Question

预先，谢谢您的所有帮助。

我要做的任务是将数据从两张表复制到“合并”表中。这两张纸都有相似的标题，但是我只需要保留一组标题即可。

到目前为止，我已经尝试了多种合并技术，但是它们要么复制所有内容，要么总结所有数值。

当我尝试将文本转换为标题时，它仅允许转换一行，也许还有另一种方式，但是我找不到它。

'下面的代码将复制带有数字的表格，但是会忽略字符串

Dim ws As Worksheet
Dim sArray As Variant, i As Integer
ReDim sArray(1 To 1)

'---Make Array with Named Ranges to be Consolidated
For Each ws In ActiveWorkbook.Worksheets
    If ws.Visible And ws.Name <> "Consolidation" Then
        i = i + 1
        ReDim Preserve sArray(1 To i)
        sArray(i) = ws.UsedRange.Address(ReferenceStyle:=XlReferenceStyle.xlR1C1, external:=True)
    End If
Next ws
If i = 0 Then Exit Sub

'---Consolidate using the Array
Sheets("Consolidation").Range("A1").Consolidate Sources:=(sArray), _
    Function:=xlSum, TopRow:=False, LeftColumn:=False, CreateLinks:=False

Sheet1： https://imgur.com/a/S0h0iHv

Sheet2： https://imgur.com/a/S0h0iHv

所需结果： https://imgur.com/a/kthyNPv

再次感谢大家的帮助。

Answer 1

Public Sub CopyRows() 
    Sheets("Sheet1").Select 
    ' Find the last row of data 
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row 
    ' Loop through each row 
    For x = 2 To FinalRow 
        ' Decide if to copy based on column D 
        ThisValue = Cells(x, 4).Value 
        If ThisValue = "A" Then 
            Cells(x, 1).Resize(1, 33).Copy 
            Sheets("SheetA").Select 
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1 
            Cells(NextRow, 1).Select 
            ActiveSheet.Paste 
            Sheets("Sheet1").Select 
        ElseIf ThisValue = "B" Then 
            Cells(x, 1).Resize(1, 33).Copy 
            Sheets("SheetB").Select 
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1 
            Cells(NextRow, 1).Select 
            ActiveSheet.Paste 
            Sheets("Sheet1").Select 
        End If 
    Next x 
End Sub

此代码有助于解决问题:-)

使用多行标题VBA合并来自多个工作表的数据

1 个答案: