Question

问题如下：我有一个包含多个工作表的excel文件，我需要将每个工作表中的G列复制到一个新工作表（列应该彼此相邻或列之间有空列）有数据）。我还想询问是否可以将每个工作表的名称放在相应列之上。

到现在为止，我使用了这段代码：

Sub Copy_G_Columns()
    Dim ws As Worksheet, i As Long
    Application.ScreenUpdating = False
    On Error Resume Next
        Set ws = Sheets("Gee Columns")
            If Err.Number <> 0 Then
                ActiveWorkbook.Sheets.Add After:=ActiveWorkbook.Sheets(Sheets.Count): ActiveSheet.Name = "Gee Columns"
                    On Error GoTo 0
                Else
                Sheets("Gee Columns").Select
            End If

        For i = 1 To ActiveWorkbook.Sheets.Count - 1
            With Sheets(i)
                    .Range("G1:G" & .Cells(.Rows.Count, 7).End(xlUp).Row).Copy Cells(2, i * 2 - 1)
                Cells(1, i * 2 - 1) = Sheets(i).Name
            End With
        Next i

    Application.ScreenUpdating = True
End Sub

它似乎几乎完美无缺。唯一的问题是，在新创建的工作表中，列中的值具有#DIV / 0错误。我认为问题是代码是复制格式而不是值。

Answer 1

以下是我对您的代码的解释。

Option Explicit

Sub allGEE()
    Dim w As Long, wsn As String, vGEEs As Variant

    wsn = "Gee Columns"

    For w = 1 To Worksheets.Count
        With Worksheets(w)
            On Error GoTo bm_NeedWorksheet
            If .Name <> Worksheets(wsn).Name Then
                On Error GoTo bm_Safe_Exit
                vGEEs = .Range(.Cells(1, 7), .Cells(Rows.Count, 7).End(xlUp)).Value
                vGEEs(1, 1) = .Name
                With Worksheets(wsn).Cells(1, w * 2 - 1)
                    .Resize(UBound(vGEEs, 1), UBound(vGEEs, 2)) = vGEEs
                End With
            End If
        End With
    Next w

    GoTo bm_Safe_Exit

bm_NeedWorksheet:
    On Error GoTo 0
    With Worksheets.Add(after:=Sheets(Sheets.Count))
        .Name = wsn
    End With
    Resume
bm_Safe_Exit:
End Sub

我保留了目的地细胞中的错位。我强烈怀疑你是在复制公式而只需要值。使用变量数组（不使用剪贴板）传输值更快。也可以进行直接值传输，但是您希望将原始工作表名称放入第一个单元格中。

将多个工作表中的列中的值复制为一个

1 个答案: