vba - 我需要编写一个 VBA 循环来找到一个非空白单元格，然后选择该行中的特定单元格以复制到另一个工作表

Question

我首先要说我对 Excel 中的 VBA 非常陌生，并且是自学成才的。我有一个用于记录培训时间的电子表格。我正在尝试编写一个代码，在“A”、“B”或“A & B”的 3 列中查找非空白单元格。一旦代码找到非空白列，我希望它选择一个特定范围（例如，A1:C1 & D1 & F1:J1），但在非空白单元格的行上，它需要将这些值复制到工作表 A、工作表 B 或工作表 A 和 B，取决于哪一列有值。我希望它粘贴到这些工作表上的下一个非空白行（在清除工作表之后，这样我就不会得到重复）到 A1:F1 的范围（抱歉，这些范围是 atm 的估计值）。然后，我需要这段代码来遍历第一张纸上并非完全空白的每一行。

我已经尝试了各种方法，并设法让它的小元素单独工作，但我正在努力让循环工作到列中的下一个非空白单元格，以及如何告诉它根据哪一列选择不同的范围它找到一个值（小时数）

到目前为止，我已经尝试过：

'Sub Macro1()
''    Dim r1, r2, r3, myMultipleRange As Range
''    Set r1 = Sheets("Record").Range(ActiveCell.Offset(0, -3), ActiveCell.Offset(0, -2))
''    Set r2 = Sheets("Record").Range(ActiveCell.Offset(0, 0))
''    Set r3 = Sheets("Record").Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 5))
''    Set myMultipleRange = Union(r1, r2, r3)
'    Sheets("Record").Select
'    Range("D4:D6").Select
'    Selection.End(xlDown).Select
'    Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 5)).Select
''    myMultipleRange.Select
'End Sub

Sub Macro1()
    Dim r1, r2, r3, myMultipleRange As Range
    Set r1 = Sheets("Record").Range("A4:b4")
    Set r2 = Sheets("Record").Range("D4")
    Set r3 = Sheets("Record").Range("F4:I4")
    Set myMultipleRange = Union(r1, r2, r3)
    myMultipleRange.Select

End Sub

我希望将第一张工作表拆分为相关的其他工作表，以便可以提取总计以及该行上的所有其他信息

这是输入选项卡“记录” 输入选项卡

这是两个输出选项卡“CPD”之一（另一个是“离职培训”）

输出选项卡

编辑：我现在对此有了进一步的了解。我没有尝试一次选择整个范围，而是尝试分别复制每个部分。如果我发表评论，我不确定我将如何循环它以遍历作为变量的所有行和三列，有什么想法吗？

Sub Macro1()
    Sheets("CPD").Select
    Range("H7:N1449").Select
    Selection.ClearContents
    Sheets("Record").Select
    Range("D4:D6").Select
    Selection.End(xlDown).Select
    Range(ActiveCell.Offset(0, -3), ActiveCell.Offset(0, -2)).Select
    Selection.Copy
    Sheets("CPD").Select
    Range("H3:K3").Select
    Selection.End(xlDown).Offset(1, 0).Select
    Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 1)).Select
    ActiveSheet.Paste
        Sheets("Record").Select
        Range("D4:D6").Select
        Selection.End(xlDown).Select
        Selection.Copy
        Sheets("CPD").Select
        Range("H3:K3").Select
        Selection.End(xlDown).Offset(1, 2).Select
        ActiveSheet.Paste
            Sheets("Record").Select
            Range("D4:D6").Select
            Selection.End(xlDown).Select
            Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 5)).Select
            Selection.Copy
            Sheets("CPD").Select
            Range("H3:K3").Select
            Selection.End(xlDown).Offset(1, 3).Select
            ActiveSheet.Paste
End Sub

标签： vbacopypaste

Answer 1

好的，经过一些反复试验，我想我已经设法提出了一个可行的解决方案。不过，请随时检查我的代码！

Sub Calculate()
    Dim x As Long
        Sheets("CPD").Select
        Range("H7:N1449").Select
        Selection.ClearContents
        Sheets("Off the job training").Select
        Range("H7:N1449").Select
        Selection.ClearContents
            For x = 1 To 50
            Sheets("Record").Select
            Range("C7").Offset(x - 1, 0).Select
                If IsEmpty(ActiveCell) Then
                    Range("D7").Offset(x - 1, 0).Select
                        If IsEmpty(ActiveCell) Then
                            Range("E7").Offset(x - 1, 0).Select
                                If IsEmpty(ActiveCell) Then
                                    Exit For
                                Else
                                    Range(ActiveCell.Offset(0, -4), ActiveCell.Offset(0, -3)).Select
                                    Selection.Copy
                                    Sheets("CPD").Select
                                    Range("H500").Select
                                    Selection.End(xlUp).Offset(1, 0).Select
                                    ActiveSheet.Paste
                                    Sheets("Off the job training").Select
                                    Range("H500").Select
                                    Selection.End(xlUp).Offset(1, 0).Select
                                    ActiveSheet.Paste
                                        Sheets("Record").Select
                                        Range("E7").Offset(x - 1, 0).Select
                                        Selection.Copy
                                        Sheets("CPD").Select
                                        Range("H500").Select
                                        Selection.End(xlUp).Offset(0, 2).Select
                                        ActiveSheet.Paste
                                        Sheets("Off the job training").Select
                                        Range("H500").Select
                                        Selection.End(xlUp).Offset(0, 2).Select
                                        ActiveSheet.Paste
                                            Sheets("Record").Select
                                            Range("E7").Offset(x - 1, 0).Select
                                            Range(ActiveCell(1, 2), ActiveCell(1, 5)).Select
                                            Selection.Copy
                                            Sheets("CPD").Select
                                            Range("H500").Select
                                            Selection.End(xlUp).Offset(0, 3).Select
                                            ActiveSheet.Paste
                                            Sheets("Off the job training").Select
                                            Range("H500").Select
                                            Selection.End(xlUp).Offset(0, 3).Select
                                            ActiveSheet.Paste
                                End If
                        Else
                            Range(ActiveCell.Offset(0, -3), ActiveCell.Offset(0, -2)).Select
                            Selection.Copy
                            Sheets("Off the job training").Select
                            Range("H500").Select
                            Selection.End(xlUp).Offset(1, 0).Select
                            ActiveSheet.Paste
                                Sheets("Record").Select
                                Range("D7").Offset(x - 1, 0).Select
                                Selection.Copy
                                Sheets("Off the job training").Select
                                Range("H500").Select
                                Selection.End(xlUp).Offset(0, 2).Select
                                ActiveSheet.Paste
                                    Sheets("Record").Select
                                    Range("D7").Offset(x - 1, 0).Select
                                    Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 5)).Select
                                    Selection.Copy
                                    Sheets("Off the job training").Select
                                    Range("H500").Select
                                    Selection.End(xlUp).Offset(0, 3).Select
                                    ActiveSheet.Paste
                        End If
                Else
                    Range(ActiveCell.Offset(0, -2), ActiveCell.Offset(0, -1)).Select
                    Selection.Copy
                    Sheets("CPD").Select
                    Range("H500").Select
                    Selection.End(xlUp).Offset(1, 0).Select
                    ActiveSheet.Paste
                        Sheets("Record").Select
                        Range("C7").Offset(x - 1, 0).Select
                        Selection.Copy
                        Sheets("CPD").Select
                        Range("H500").Select
                        Selection.End(xlUp).Offset(0, 2).Select
                        ActiveSheet.Paste
                            Sheets("Record").Select
                            Range("C7").Offset(x - 1, 0).Select
                            Range(ActiveCell.Offset(0, 3), ActiveCell.Offset(0, 6)).Select
                            Selection.Copy
                            Sheets("CPD").Select
                            Range("H500").Select
                            Selection.End(xlUp).Offset(0, 3).Select
                            ActiveSheet.Paste
                End If
            Next x
End Sub