Excel,VBA和移动行

时间:2015-04-22 13:40:32

标签: excel excel-vba vba

我是新手:VBA和宏(创建或运行)。我需要一些代码帮助,这些代码可以帮助我将一行从一个电子表格复制到另一个电子表格,将其保留在原始表格中并以某种方式标记(我认为),或者确保将来不再复制它。我发现了一些关于移动行的帖子,大多数都依赖于日期条目,但这不符合我的目的。我的工作表有一个列(H),带有下拉数据验证 - 从下拉列表进入单元格的任何条目都会将该行标识为要复制到下一个工作表的行。但是,在(J)之后还有一个列,其中数据输入是可选的,我不希望在给用户输入该列的机会之前复制该行,以便它的内容也会复制(或者也许是一组单独的代码?)。复制到新电子表格的行应插入下一个可用行。谢谢你的帮助和帮助您可以提供的说明。

1 个答案:

答案 0 :(得分:1)

好的 - 有了信息。我收集了你的帖子,我有以下内容:

Sub copyRows()
Dim xRow As Integer, xCol As Integer, lastCol As Integer
Dim dataValidation As Range, rowToCopy As Integer, copyRange As Range, destRange As Range
Dim copyWSRow As Integer, jColValue As String
Dim origWS As Worksheet, copyWS As Worksheet

Set origWS = ActiveSheet

' Edit these two lines as needed.  If you have the "copy" worksheet already, comment out the first line
' and then change the 'Sheets("Copy")' to 'Sheets("_____")'
Worksheets.Add(after:=Worksheets(1)).Name = "Copy"
Set copyWS = Sheets("Copy")

origWS.Activate

Set dataValidation = origWS.Cells(1, 8) ' Cell H1 has your data validation.  Change this as necessary
rowToCopy = dataValidation.Value

'find the last column used, that isn't Col. H.  If it's column H, assume G is the last column
lastCol = origWS.Cells(1, 1).End(xlToRight).Column
If lastCol = 8 Then lastCol = lastCol - 1

With origWS
Set copyRange = .Range(.Cells(rowToCopy, 1), .Cells(rowToCopy, lastCol))
End With

'What's the next available row in the Copy WS?
If copyWS.UsedRange.Rows.Count = 1 And copyWS.Cells(1, 1).Value = "" Then
    copyWSRow = 1
Else
    copyWSRow = copyWS.UsedRange.Rows.Count + 1 ' count the used rows, and add one to make the next blank row the row to copy to
End If
'Set the destination Range

With copyWS
Set destRange = .Range(.Cells(copyWSRow, 1), .Cells(copyWSRow, lastCol))
End With

'Now, just copy the info over (technically, just set values equal)
destRange.Value = copyRange.Value

'Now, check to see if Column J has any info - if so, add to the line we just did in the Copy WS
If origWS.Cells(1, 10).Value <> "" Then
    jColValue = origWS.Cells(1, 10).Value
    copyWS.Cells(copyWSRow, 10).Value = jColValue
End If



 ' Add note that the row was copied
    origWS.Cells(rowToCopy,13).Value = "Already Copied"

    End Sub

一些注意事项:我假设最右边的列,包含要复制的数据,将是G列 - 因为H具有行值。

此外,我将H1作为进行数据验证的单元格 - 您可能需要根据需要对其进行编辑。

我用一些数据测试了这一点,在A到G栏中,H1和J1是数据验证(输出一个数字),J1是&#34;额外&#34;信息。如果你想要&#39;额外信息&#39;要在数据的每一行上,而不是在一个绝对点,只需将jColValue公式更改为jColValue = origWS.Cells(rowToCopy,10).Value

当然,如果这不起作用或需要调整,请告诉我。