Question

我是VBA的新手，我在编写某个宏时遇到问题。我已经从数据库中检索到约150种债券的每日收益率，要价和买入价的数据。所有的收益率，要价和买价都按顺序排列在不同的工作表中。我想为每种债券获取一张新的具有相应收益率，买入价和要价的表。我的收益率在工作表2中，要价在工作表3中，买入价在工作表4中。它应始终复制两列，例如，对于第一个债券，它应复制前两列（两列是因为表2的收益率和日期），表3的前2列和表4的前两列，并将它们彼此相邻放置在新表中，对于下一个键，它应复制每个表的下两个列工作表并将其复制到新工作表中，依此类推。是否可以编写宏来执行此操作？

以下是我为前两个键手动完成的宏的记录

ActiveCell.Offset(0, -6).Columns("A:B").EntireColumn.Select
ActiveCell.Offset(0, -6).Range("A1").Activate
Selection.Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste
Sheets("Sheet3").Select
ActiveCell.Columns("A:B").EntireColumn.Select
ActiveCell.Offset(1, 0).Range("A1").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet7").Select
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet4").Select
ActiveCell.Columns("A:B").EntireColumn.Select
ActiveCell.Offset(1, 0).Range("A1").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet7").Select
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveSheet.Paste
Sheets.Add After:=ActiveSheet
Sheets("Sheet2").Select
ActiveCell.Offset(0, 2).Columns("A:B").EntireColumn.Select
ActiveCell.Offset(0, 2).Range("A1").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet8").Select
ActiveSheet.Paste
Sheets("Sheet3").Select
ActiveCell.Offset(0, 2).Range("A1:B1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Ask Close"
ActiveCell.Columns("A:B").EntireColumn.Select
ActiveCell.Activate
Selection.Copy
Sheets("Sheet8").Select
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet4").Select
ActiveCell.Offset(0, 2).Columns("A:B").EntireColumn.Select
ActiveCell.Offset(0, 2).Range("A1").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet8").Select
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveSheet.Paste

Answer 1

只要您的工作表都具有默认名称，此操作就可以完成。

Option Explicit

Sub copyColtoSheet()
Dim pasteSheet As Worksheet
Dim copySheet As Worksheet
Dim i As Integer

'Create new sheet to paste column data to
With ThisWorkbook
    .Sheets.Add After:=.Sheets(.Sheets.Count)
    Set pasteSheet = .Worksheets("Sheet" & .Sheets.Count)
End With

'Copy Sheet columns to new sheet
Dim pasteColumn As Integer
pasteColumn = 1
For i = 2 To 4
    With pasteSheet
        Dim allRows As Integer
        Set copySheet = ThisWorkbook.Worksheets("Sheet" & i)
        allRows = copySheet.Cells(Rows.Count, 1).End(xlUp).Row
        .Range(.Range(.Cells(1, pasteColumn), .Cells(allRows, pasteColumn)), .Range(.Cells(1, pasteColumn + 1), .Cells(allRows, pasteColumn + 1))).Value = copySheet.Range("A:B").Value
        pasteColumn = pasteColumn + 2
    End With
Next i
End Sub

我已经测试了此代码，并且可以正常工作。

创建循环以从三个工作表中复制整个列，并在新工作表中对其进行排序

1 个答案: