VBAselect性复制?

我正在寻找复制某些列单元格一次一行(即A2,C2,G2,然后到A3,C3,G2)粘贴到一个新的表。 我看过使用:

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

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

一些伪代码:

  1. 遍历每一
  2. 如果A列中的date限制为条件语句,则复制预定义的列值并复制到新工作表。
  3. 检查下一行。

我目前有一个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 

我在思考每一个select,我会做同样的声明,但复制到新的工作表呢? 先谢谢你!

您可以按照您想要的任何顺序select范围。

例如,你可以使用:

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

selectAC,E和G列

这里是一个单元格:

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

这是一次一行:

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

你的请求和你所拥有的代码并不匹配,所以我正在猜测你的主要想法是什么。 这不会(可能)解决问题,但希望能告诉你如何可以去做这件事。

仔细阅读以下内容,看看它是否与您正在寻找的相似:

 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, ie '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单步执行,看它如何一次一行地工作。