Question

我正在处理2张不同的纸张，即Sheet1和Sheet2。

现在，如果两个文件中的列标题相同，我已设法合并2张。那么如何合并到一个选择特定列的组合文件中。

我现在的问题是2张之间的标题是不同的，所以我很难合并2个不同的标题，但它包含相同类型的数据。例如，Sheet1使用First Name作为其列标题，Sheet2使用Nickname作为其列标题。

我也不希望它复制整个列，因为它包含要合并的无关紧要的列。

我附上预期结果作为参考。

Sub Combine()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Combined"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub

Answer 1

我已添加到您的代码中并对其进行了评论。我希望这会有所帮助。

Sub Combine()

    Dim J As Integer
    Dim Rng As Range            ' specify a range to copy
    Dim R As Long               ' set a variable to calculate a row number

'    On Error Resume Next       ' You want to see the errors and fix them
                                ' therefore don't suppress them
'    Sheets(1).Select           ' you don't need to "select" anything
'    Worksheets.Add             ' instead of adding a sheet I suggest you
                                ' you create a copy of Shhet(1)

    Sheets("Sheet1").Copy Before:=Sheets(1)
    ' the new sheet will now be the "ActiveSheet"
    With ActiveSheet
        .Name = "Combined"
        ' delete all the columns you don't want to keep, like:-
        .Columns("C:K").Delete      ' or .Columns("F").Delete
        ' if you delete individual columns, delete from right to left (!!)
    End With

    ' this part is already done
'    Sheets(2).Activate         ' you don't need to select anything
'    Range("A1").EntireRow.Select
'    Selection.Copy Destination:=Sheets(1).Range("A1")

    ' Note that sheets are numbered 1 and up.
    ' Therefore the newly inserted sheet is now # 1
    ' and the previous #1 is now Sheet(2)
    For J = 3 To Sheets.Count
'        Sheets(J).Activate      ' you don't need to activate anything
'        Range("A1").Select      ' you don't need to select anything either
'        Selection.CurrentRegion.Select     ' the Selection is already selected
        With Sheets(J)
            ' Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
            ' It appears that you want to select the range from A2 to lastrow in A -1
            R = .Cells(.Rows.Count, "A").End(xlUp).Row
            Set Rng = .Range(.Cells(2, "A"), .Cells(R - 1, "A"))
            ' avoid using the Selection object. Use Range object instead:-
            ' Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
            Rng.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
        End With
    Next J
End Sub

请注意，您可以在一次操作中复制包含多个列的范围。只需更改您复制的范围的定义即可。这将复制A：E列。

Set Rng = .Range(.Cells(2, "A"), .Cells(R - 1, "E"))

无需进行其他更改。

Answer 2

如果您知道数据所在的列，则可以使用简单的Do Until循环

来处理表格/列

参见示例/并查看对代码的评论

Option Explicit
Public Sub Example()
    Dim B As Range, _
        C As Range, _
        D As Range, _
        E As Range, _
        F As Range, _
        G As Range ' Columns on Sheet1 & Sheet2

    Dim i%, x% ' Dim as long

    Dim Sht As Worksheet  ' Every Sheet on This Workbook
    Dim Comb As Worksheet ' Combine Sheet

    Set Comb = ThisWorkbook.Worksheets("Combine")

    i = 2 ' Start on row 2 - Sheet1 & Sheet2
    x = 2 ' Start on row 2 - Combine sheet

    'Looping through the worksheets in the workbook
    For Each Sht In ThisWorkbook.Worksheets
        ' ignore Sheet "Combine"
        If Sht.Name <> "Combine" Then
            Debug.Print Sht.Name ' Print on Immediate Window

            Set B = Sht.Columns(2)
            Set C = Sht.Columns(3)
            Set D = Sht.Columns(4)
            Set E = Sht.Columns(5)
            Set F = Sht.Columns(6)

            Do Until IsEmpty(B.Cells(i))

                Comb.Columns(1).Cells(x).Value = B.Cells(i).Value
                Comb.Columns(2).Cells(x).Value = C.Cells(i).Value
                Comb.Columns(3).Cells(x).Value = D.Cells(i).Value
                Comb.Columns(4).Cells(x).Value = E.Cells(i).Value
                Comb.Columns(5).Cells(x).Value = F.Cells(i).Value

                i = i + 1
                x = x + 1
            Loop

        End If

        i = 2 ' Reset 1st Loop

    Next

    ' Auto-Fit Rows & Columns
    With Comb.Cells
        .Rows.AutoFit
        .Columns.AutoFit
    End With
End Sub

另见copy/paste - values = values - PasteSpecial method

上的示例

另见How to avoid using Select in Excel VBA macros

具有不同标头

2 个答案: