VBA 选择性复制？

Question

我希望一次将某些列单元格复制一行（即 A2、C2、G2 然后复制到 A3、C3、G2）粘贴到新工作表上。我看过使用：

Sheets("Sheet1").Range("A1:A10").Copy 

但我需要从某些列复制数据。

一些伪代码：

1. 遍历每个行
2. 如果 A 列中的日期仅限于条件语句，则复制预先确定的列值并复制到新工作表。
3. 检查下一行。

我目前有一个从第 1 行迭代到第 50 行的 for 循环。

'Copy Titles
    Sheet2.Range("A1, E1, J1, K1, W1:X1, Y1, AA1").Copy
    Sheets.Add
    ActiveSheet.Range("A1").PasteSpecial
'Copy Data   
'If today's date is later than a date in the Column A, copy the cell over.
?


'Fix Column Width
    Range("A1:H1").ColumnWidth = 20
'Align Columns
    Columns("A:H").HorizontalAlignment = xlCenter

End Sub

我在考虑在每个选择下，我会做同样的陈述，而是复制到新的工作表上？先感谢您！

Answer 1

您可以按您想要的任何顺序选择范围。

例如，您可以使用：

Range("A1:C1,E1,G1").Select

选择 A-C、E 和 G 列

Answer 2

这是一次一个单元格：

Sheets("Sheet2").Range("A1").Value = Sheets("Sheet1").Range("A1").Value

这里是一行：

Sheets("Sheet1").Rows("1:1").Copy Destination:=Sheets("Sheet2").Rows("1:1")

Answer 3

您的请求和您拥有的代码并不真正匹配，所以我正在猜测您的主要想法是什么。这不会（可能）解决问题，但希望可以向您展示如何解决此问题。

阅读以下内容，看看是否与您要查找的内容相似：

Sub move_Info()
' This sub will look in each cell in column A, and if the cell's date is BEFORE today's date,
' then copy the cell, to a new row in a new sheet, same column.

Dim cel As Range, rng As Range
Dim iDate$, tDay As Date
Dim columnsToCheck() As Variant
Dim dataWS As Worksheet, newWS As Worksheet

Set dataWS = Sheets("Sheet1") ' Change this as needed. This is where your data is.
Set newWS = Sheets.Add(after:=dataWS)
newWS.Name = "Copied Info"

columnsToCheck() = Array(1, 2) ' this will check Columns A and B. To add more, just add more numbers, i.e.
'columnToCheck() = Array(1,2,3,5)

tDay = Date
Debug.Print "Today is " & tDay

Dim i&, lastRow&, nextRow&
nextRow = 1

dataWS.Activate

With dataWS
    For i = LBound(columnsToCheck) To UBound(columnsToCheck)
        lastRow = .Cells(.Rows.Count, columnsToCheck(i)).End(xlUp).Row
        Set rng = .Range(.Cells(1, columnsToCheck(i)), .Cells(lastRow, columnsToCheck(i)))

        For Each cel In rng
            If cel.Value < tDay Then
                cel.Copy
                newWS.Range(newWS.Cells(nextRow, columnsToCheck(i)), newWS.Cells(nextRow, columnsToCheck(i))).PasteSpecial
                nextRow = newWS.Cells(newWS.Rows.Count, columnsToCheck(i)).End(xlUp).Row + 1
                Application.CutCopyMode = False
            End If
        Next cel

        'Reset nextRow, since you're starting in a new column
        nextRow = 1
    Next i
End With

End Sub

您可以使用 F8 单步执行它，以一次一行地观察它是如何工作的。