时间戳

首页 > 解决方案 > 使用多行标题VBA合并来自多个工作表的数据

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

问题描述

在此先感谢您的所有帮助。

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

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

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

'下面的代码复制数字，如果我将表格与数字，但忽略字符串

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

表 1： https ://imgur.com/a/S0h0iHv

表 2： https ://imgur.com/a/S0h0iHv

期望的结果： https ://imgur.com/a/kthyNPv

再次感谢大家的帮助。

标签： excelvba

解决方案

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

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

推荐阅读