[英]Macro to copy-paste range in row to different sheets based on specific cell value
I have a workbook with 3 sheets: first one is the raw data sheet, then 2 target sheets. 我有一本包含3张纸的工作簿:第一个是原始数据表,然后是2个目标表。 I would need a macro that would look at cell C in raw data sheet and based on the 2 values (YES or NO), will copy and paste the range A:Y in sheets 2, respectively 3. Example: if on C2 in raw data sheet i have YES, copy A2:Y2 and paste into sheet 2, same range A2:Y2. 我需要一个宏,该宏将查看原始数据表中的单元格C,并基于2个值(是或否)分别复制并粘贴工作表2中3的范围A:Y。示例:如果在原始数据中的C2上数据表我有,复制A2:Y2并粘贴到工作表2中,相同范围A2:Y2。 If instead i have the value NO, copy A2:Y2 and paste into sheet 3. Then go to next row and copy-paste A3:Y3 to sheet 2 if YES or A3:Y3 to sheet 3 if NO. 如果我的值为NO,则复制A2:Y2并粘贴到工作表3中。然后转到下一行,如果是,则将A3:Y3复制并粘贴到工作表2上,如果不是,则将A3:Y3复制并粘贴到工作表3中。
I wrote something that only works for the 2nd row, but i don't know how to make it loop... so basically when it passes to the next rows, it still copies the values from A2:Y2 to the target sheet, instead of copying A3:Y3, A4:Y4 etc.. Pasting my poor code below: 我写了一些仅适用于第二行的内容,但我不知道如何使其循环...因此基本上,当它传递到下一行时,它仍然将值从A2:Y2复制到目标工作表,而不是复制A3:Y3,A4:Y4等。在下面粘贴我的可怜代码:
Sub IdentifyInfraction()
Dim rngA As Range
Dim cell As Range
Set rngA = Range("C2", Range("C65536").End(xlUp))
For Each cell In rngA
Worksheets("raw_data").Select
If cell.Value = "YES" Then
Range("A2:Y2").Copy
Worksheets("Value_YES").Select
Range("A2").PasteSpecial Paste:=xlPasteValues
ElseIf cell.Value = "NO" Then
Range("A2:Y2").Copy
Worksheets("Value_NO").Select
Range("A2").PasteSpecial Paste:=xlPasteValues
End If
Next cell
End Sub
Please help!!! 请帮忙!!! :-s :-s
Easiest solution would just be to replace the number 2
in each of your ranges to a variable which you then increment at the end your statement, before you go to the next cell. 最简单的解决方案是将每个范围中的数字2
替换为变量,然后在转到下一个单元格之前在语句的末尾递增。
For example: 例如:
Dim i = 2
Set rngA = Range("C2", Range("C65536").End(xlUp))
For Each cell In rngA
Worksheets("raw_data").Select
If cell.Value = "YES" Then
Range("A" & i & ":Y" & i).Copy
Worksheets("Value_YES").Select
Range("A" & i).PasteSpecial Paste:=xlPasteValues
ElseIf cell.Value = "NO" Then
Range("A" & i & ":Y" & i).Copy
Worksheets("Value_NO").Select
Range("A" & i).PasteSpecial Paste:=xlPasteValues
End If
i = i + 1
Next cell
So, originally we set i = 2
, this is to go in line with your starting row of 2
mentioned in your question. 因此,最初我们将i = 2
设置为与问题中提到的起始行2
。 Then, Range("A" & i & ":Y" & i).Copy
is the same as saying Range("A2:Y2").Copy
or Range("A3:Y3").Copy
, etc. 然后, Range("A" & i & ":Y" & i).Copy
于说Range("A2:Y2").Copy
或Range("A3:Y3").Copy
等。
This will go through any copy each row, a new row each time, and paste it to the respective row in the various sheets. 这将遍历每行的任何副本,每次遍历新行,并将其粘贴到各个工作表的相应行中。
I hope this works for what you are trying to do, if not let me know. 我希望这对您尝试做的事情有效,如果没有让我知道。
There are a few things I'd also recommend looking into. 我还建议您注意一些事项。 There's a much better way to copy and paste, without going back and forward through the sheets. 有一种更好的复制和粘贴方法,而无需在图纸之间来回移动。
ThisWorkbook.Sheets("raw_data").Rows(i).Copy Destination:=Worksheets("Value_YES").Range("A" & i)
Something like this would take the whole row from raw_data
and transfer it to Value_YES
. 这样的事情会把raw_data
的整个行转移到Value_YES
。 You'd have to mess around with it and change the range from Rows(i)
, but that's just an example. 您必须弄乱它并更改Rows(i)
的范围,但这只是一个例子。
I'd also recommend that you look into How to avoid using Select in Excel VBA to better understand why it's frowned upon to use Select and Activate in Excel VBA. 我还建议您研究如何避免在Excel VBA中使用“选择”,以更好地理解为什么在Excel VBA中使用“选择并激活”的原因。
My version: 我的版本:
Sub GetR_Done()
Dim rng As Range, c As Range, LstRw As Long
Dim ws As Worksheet, Nr As Long, Yr As Long
Dim Ys As Worksheet, Ns As Worksheet
Set ws = Sheets("raw_data")
Set Ys = Sheets("Value_YES")
Set Ns = Sheets("Value_NO")
With ws
LstRw = .Cells(.Rows.Count, "C").End(xlUp).Row
Set rng = .Range("C2:C" & LstRw)
For Each c In rng.Cells
If c = "YES" Then
With Ys
Yr = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
.Range(.Cells(c.Row, "A"), .Cells(c.Row, "Y")).Copy Ys.Range("A" & Yr)
End If
If c = "NO" Then
With Ns
Nr = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
.Range(.Cells(c.Row, "A"), .Cells(c.Row, "Y")).Copy Ns.Range("A" & Nr)
End If
Next c
End With
End Sub
If you really require to paste values, then use this one 如果您确实需要粘贴值,请使用此值
Sub GetR_Done()
Dim rng As Range, c As Range, LstRw As Long
Dim ws As Worksheet, Nr As Long, Yr As Long
Dim Ys As Worksheet, Ns As Worksheet
Set ws = Sheets("raw_data")
Set Ys = Sheets("Value_YES")
Set Ns = Sheets("Value_NO")
Application.ScreenUpdating = False
With ws
LstRw = .Cells(.Rows.Count, "C").End(xlUp).Row
Set rng = .Range("C2:C" & LstRw)
For Each c In rng.Cells
If c = "YES" Then
With Ys
Yr = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
.Range(.Cells(c.Row, "A"), .Cells(c.Row, "Y")).Copy
Ys.Range("A" & Yr).PasteSpecial xlPasteValues
End If
If c = "NO" Then
With Ns
Nr = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
.Range(.Cells(c.Row, "A"), .Cells(c.Row, "Y")).Copy
Ns.Range("A" & Nr).PasteSpecial xlPasteValues
End If
Next c
End With
Application.CutCopyMode = False
End Sub
you could try this: 您可以尝试以下方法:
Sub IdentifyInfraction()
Dim cell As Range
With Worksheets("raw_data") 'reference "raw data" sheet
For Each cell In .Range("C2", .cells(.Rows.Count, "C").End(xlUp)) ' loop through referenced sheet column C cells from row 2 down to last not empty one
Worksheets("Value_" & cell.Value).Range(cell.Address).Resize(, 25).Value = cell.Resize(, 25).Value 'have proper target sheet A:Y current cell row values as "raw data" sheet ones
Next
End With
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.