复制并粘贴相同 Sheet
Copy and Paste on the Same Sheet
我有一个用作数据库的工作簿,带有输入页。我想使 A 列动态化,这将更新作品 sheet 所有页面上的 header 行。我创建了一个宏,它从输入 Sheet 的 A 列复制这些 header 名称,并将这些值作为 header 粘贴到下一个 sheet。一旦标记了这些 header 行,它们就会被复制到 Sheet 2 上,这样它们就可以作为额外的 header 行粘贴到先前粘贴的值的右侧。原因是因为它们是在 Start 和 Stop 时间监控的值,每次都会存储不同的数据。另外,我希望这些 header 行周围有中等粗细的边框。我已经起草了以下代码,但它只能通过按预期复制第一组来部分正确,但是第二个副本部分不能正常工作。我希望在文档中创建一个模板 sheet,其中包含日期、开始时间、Space、结束时间。这意味着需要以动态方式在开始时间之后插入复制行,并在结束时间之后再次插入复制行,以便该列表可以增长。请查看我附加的代码,非常感谢您的帮助。
Sub CopyData2()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim wb As Workbook
Dim lRow As Long
Dim lCol1 As Long
Dim lCol2 As Long
Dim cRange As Range
Dim iCell As Range
Dim iRange As Range
Set wb = ThisWorkbook
Set ws1 = wb.Sheets(1)
Set ws2 = wb.Sheets(2)
lRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
lCol1 = ws2.Cells(12, Columns.Count).End(xlToLeft).Column
lCol2 = ws2.Cells(3, Columns.Count).End(xlToLeft).Column
ws1.Range("A13:A" & lRow).Copy
ws2.Range("C3").PasteSpecial xlPasteValues, Transpose:=True
Set cRange = ws2.Range(("C3"), ws2.Range("C3").End(xlToRight))
cRange.Select
cRange.Copy
ws2.Cells(3, lCol2).PasteSpecial xlPasteValues
End Sub
我不明白你想用 Start/Stop 次做什么,但尝试删除 cRange.Select
来修复第二次 Copy/Paste
我建议将最后 4 行替换为以下内容
With ws2.Range(("C3"), ws2.Range("C3").End(xlToRight))
ws2.Cells(3, lCol2).Resize(.Rows.Count,.Columns.Count).Value2 = .Value2
End With
为了避免Select、和冗余使用剪贴板。
我有一个用作数据库的工作簿,带有输入页。我想使 A 列动态化,这将更新作品 sheet 所有页面上的 header 行。我创建了一个宏,它从输入 Sheet 的 A 列复制这些 header 名称,并将这些值作为 header 粘贴到下一个 sheet。一旦标记了这些 header 行,它们就会被复制到 Sheet 2 上,这样它们就可以作为额外的 header 行粘贴到先前粘贴的值的右侧。原因是因为它们是在 Start 和 Stop 时间监控的值,每次都会存储不同的数据。另外,我希望这些 header 行周围有中等粗细的边框。我已经起草了以下代码,但它只能通过按预期复制第一组来部分正确,但是第二个副本部分不能正常工作。我希望在文档中创建一个模板 sheet,其中包含日期、开始时间、Space、结束时间。这意味着需要以动态方式在开始时间之后插入复制行,并在结束时间之后再次插入复制行,以便该列表可以增长。请查看我附加的代码,非常感谢您的帮助。
Sub CopyData2()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim wb As Workbook
Dim lRow As Long
Dim lCol1 As Long
Dim lCol2 As Long
Dim cRange As Range
Dim iCell As Range
Dim iRange As Range
Set wb = ThisWorkbook
Set ws1 = wb.Sheets(1)
Set ws2 = wb.Sheets(2)
lRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
lCol1 = ws2.Cells(12, Columns.Count).End(xlToLeft).Column
lCol2 = ws2.Cells(3, Columns.Count).End(xlToLeft).Column
ws1.Range("A13:A" & lRow).Copy
ws2.Range("C3").PasteSpecial xlPasteValues, Transpose:=True
Set cRange = ws2.Range(("C3"), ws2.Range("C3").End(xlToRight))
cRange.Select
cRange.Copy
ws2.Cells(3, lCol2).PasteSpecial xlPasteValues
End Sub
我不明白你想用 Start/Stop 次做什么,但尝试删除 cRange.Select
来修复第二次 Copy/Paste
我建议将最后 4 行替换为以下内容
With ws2.Range(("C3"), ws2.Range("C3").End(xlToRight))
ws2.Cells(3, lCol2).Resize(.Rows.Count,.Columns.Count).Value2 = .Value2
End With
为了避免Select、和冗余使用剪贴板。