我需要编写一个 VBA 循环来查找非空白单元格，然后选择该行中的特定单元格以复制到另一个 sheet
I need to write a VBA loop that finds a non-blank cell, then selects specific cells in that row to copy to another sheet
首先我要说我是 Excel 中 VBA 的新手并且是自学的。
我有一个 spreadsheet 用于记录培训时间。我正在尝试编写一个代码，在 "A"、"B" 或 "A & B" 的 3 列中查找非空白单元格。一旦代码找到非空白列，我希望它然后 select 一个特定范围（例如，A1:C1 & D1 & F1:J1）但在非空白单元格的行上，然后它需要将这些值复制到 sheet A、sheet B 或 sheets A 和 B，具体取决于哪一列具有值。我希望它粘贴到这些 sheet 上的下一个 none 空白行（在清除 sheet 之后，这样我就不会重复）到 [=40] 的范围=]（抱歉，这些范围是估计的 atm）。
然后我需要这段代码循环遍历第一个 sheets.
中不完全空白的每一行
我已经尝试了各种方法并设法让它的小元素单独工作，但我正在努力让循环工作到列中的下一个非空白单元格以及如何告诉它 select 不同的范围取决于它找到值的列（小时数）
到目前为止我已经尝试过：
'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
我希望将第一个 sheet 分成相关的其他 sheet，以便可以提取总计和该行的所有其他信息
这是输入选项卡"Record"
Input tab
这是两个输出选项卡之一"CPD"（另一个是"Off the job training"）
Output tab
编辑：我现在对此有了更进一步的了解。我没有尝试 select 一次复制整个范围，而是尝试分别复制每个部分。如果我发表评论，我不确定我将如何通过作为变量的所有行和三列将其循环到 运行，有什么想法吗？
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
好的，经过反复试验，我想我已经找到了可行的解决方案。不过，请随时检查我的代码！
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
首先我要说我是 Excel 中 VBA 的新手并且是自学的。 我有一个 spreadsheet 用于记录培训时间。我正在尝试编写一个代码，在 "A"、"B" 或 "A & B" 的 3 列中查找非空白单元格。一旦代码找到非空白列，我希望它然后 select 一个特定范围（例如，A1:C1 & D1 & F1:J1）但在非空白单元格的行上，然后它需要将这些值复制到 sheet A、sheet B 或 sheets A 和 B，具体取决于哪一列具有值。我希望它粘贴到这些 sheet 上的下一个 none 空白行（在清除 sheet 之后，这样我就不会重复）到 [=40] 的范围=]（抱歉，这些范围是估计的 atm）。 然后我需要这段代码循环遍历第一个 sheets.
中不完全空白的每一行我已经尝试了各种方法并设法让它的小元素单独工作，但我正在努力让循环工作到列中的下一个非空白单元格以及如何告诉它 select 不同的范围取决于它找到值的列（小时数）
到目前为止我已经尝试过：
'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
我希望将第一个 sheet 分成相关的其他 sheet，以便可以提取总计和该行的所有其他信息
这是输入选项卡"Record" Input tab
这是两个输出选项卡之一"CPD"（另一个是"Off the job training"）
Output tab
编辑：我现在对此有了更进一步的了解。我没有尝试 select 一次复制整个范围，而是尝试分别复制每个部分。如果我发表评论，我不确定我将如何通过作为变量的所有行和三列将其循环到 运行，有什么想法吗？
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
好的，经过反复试验，我想我已经找到了可行的解决方案。不过，请随时检查我的代码！
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