Question

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

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

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

一些伪代码：

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

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

'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 逐步浏览它，一次观察它是如何工作的。

VBA选择性复制？

3 个答案: