[英]How to copy and paste multiple column data from one sheet to another sheet using vba
I'm very new to VBA and I have been trying to develop a tool to merge two sheets with only selected columns of data to output sheet.我对 VBA 很陌生,我一直在尝试开发一种工具来将两张仅包含选定数据列的工作表合并到输出工作表中。
I have two sheets with name RCV and MGT.我有两张名为 RCV 和 MGT 的工作表。 Both have a unique column where it should be matched and paste it on the 3rd sheet which has the name Output.
两者都有一个唯一的列,它应该匹配并将其粘贴到名称为输出的第三张纸上。
I tried moving from one cell to another but as the data size too large it takes too long time as the iteration for checking each cell is too high.我尝试从一个单元格移动到另一个单元格,但由于数据量太大,检查每个单元格的迭代时间太长,因此需要很长时间。
The RCV sheet has around 35000 rows of data and MGT sheet has around 25000 rows of data. RCV 表有大约 35000 行数据,MGT 表有大约 25000 行数据。
Sub Merge_Data()
Dim i, j
Dim k
Dim WS1 As Worksheet
Set WS1 = ThisWorkbook.Sheets("RCV")
Dim WS2 As Worksheet
Set WS2 = ThisWorkbook.Sheets("MGT")
Dim files As Variant
Dim LRow1 As Long
LRow1 = WS1.Range("A" & WS1.Rows.Count).End(xlUp).Row
Dim LRow2 As Long
LRow2 = WS2.Range("A" & WS2.Rows.Count).End(xlUp).Row
k = 3
For i = 2 To LRow1
For j = 2 To LRow2
If Sheets("RCV").Cells(i, "Q").Value = Sheets("RCV").Cells(j, "AD").Value
Then
Sheets("Output").Cells(k, "F").Value = Sheets("RCV").Cells(i, "Q").Value
Sheets("Output").Cells(k, "H").Value = Sheets("RCV").Cells(i, "R").Value
Sheets("Output").Cells(k, "A").Value = Sheets("MGT").Cells(j, "V").Value
k = k + 1
End If
Next
Next
End Sub
Please do help me how to solve this issue.请帮助我如何解决这个问题。 I need to copy multiple columns from RCV sheet and MGT sheet when the condition matches (Column Range from Q2 to Lastrow = AD2 to Lastrow).
当条件匹配时,我需要从 RCV 工作表和 MGT 工作表中复制多列(列范围从 Q2 到 Lastrow = AD2 到 Lastrow)。
The output sheet after merging columns from RCV sheet and MGT sheet:将 RCV 表和 MGT 表中的列合并后的输出表:
since you have far less then 60k row or so, you could exploit AutoFilter()
method of Range
object with xlFilterValues
operator, allowing you to filter on more values:由于您的行数远少于 60k 左右,因此您可以使用
xlFilterValues
运算符利用Range
对象的AutoFilter()
方法,允许您过滤更多值:
Option Explicit
Sub Merge_Data()
Dim sheet1Data As Variant
With Worksheets("MGT") '<--| reference your worksheet "MGT"
sheet1Data = Application.Transpose(.Range("AD2", .Cells(.Rows.Count, "AD").End(xlUp)).Value) '<--| fill an array with referenced sheet column AD values from row 2 down to last not empty one
End With
With Worksheets("RCV") '<--| reference your worksheet "RCV"
With .Range("Q1", .Cells(.Rows.Count, "Q").End(xlUp)) '<--| reference referenced sheet column Q cells from row 1 (header) down to last not empty one
.AutoFilter Field:=1, Criteria1:=sheet1Data, Operator:=xlFilterValues '<--| filter refrenced cells with sheet 2 column A values
If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then ' if any match
Dim cell As Range, k As Long
k = 3
For Each cell In .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible) ' loop through referenced range filtered cells (skipping header)
Worksheets("Output").Cells(k, "F").Value = Worksheets("RCV").Cells(cell.Row, "Q").Value
Worksheets("Output").Cells(k, "H").Value = Worksheets("RCV").Cells(cell.Row, "R").Value
Worksheets("Output").Cells(k, "A").Value = Worksheets("MGT").Cells(Application.Match(cell.Value2, sheet1Data, 0) + 1, "V").Value
k = k + 1
Next
End If
End With
.AutoFilterMode = False
End With
End Sub
This will go through each row in WS1 and copy each cell in the row to WS2 in a new line.这将遍历 WS1 中的每一行,并在新行中将该行中的每个单元格复制到 WS2。 Some syntax might be wrong because I didn't test it or write in in my excel vba editor.
有些语法可能是错误的,因为我没有测试它或在我的 excel vba 编辑器中写入。 But this is my solution.
但这是我的解决方案。
dim lastrow1 as long
dim lastrow2 as long
dim i as long
dim j as long
lastrow1 = Application.CountA(WS1.Range("A:A"))
lastrow2 = Application.CountA(WS2.Range("A:A"))
Application.ScreenUpdating = False 'not necessary but this will speed things up
for i = 1 to lastrow1
lastCol1 = WS1.Cells(i, Columns.Count).End(xlToLeft).Column
'counting used columns in each row
lastrow2 = lastrow2 + 1 'starting a new row in WS2
for j = 1 to lastCol1
WS2.Cells(lastrow2,j).Value = WS1.Cells(i,j).Value
next j
next i
Application.ScreenUpdating = True 'in pair with screenupdating=false
"Could you let me know how could I copy selected column cells from Sheet 1 (RCV) and Sheet 2 (MGT) together to Sheet 3 (Output) when Column Cell values (Q - RCV) and Column cell values (AD - MGT) matches ? " “当列单元格值 (Q - RCV) 和列单元格值 (AD - MGT) 时,您能否让我知道如何将工作表 1 (RCV) 和工作表 2 (MGT) 中选定的列单元格复制到工作表 3(输出)火柴 ? ”
This could be a heavy way.这可能是一个沉重的方式。 But you could make it faster when you get more familiar with vba.
但是当你更熟悉 vba 时,你可以让它更快。 Or someone else would give a lighter way later.
或者其他人稍后会给出更轻松的方法。
'i is for WS1's rows and j is for WS2's now. col is for column count in a specific line.
dim col as long
dim rowWS3 as long
Set WS3 = ActiveWorkbook.Sheets("output")
for i = 1 to lastrow1
for j = 1 to lastrow2
if WS1.Cells(i,17) = WS2.Cells(j,30) 'you may add the .Value if needed
'Q is the 17th column and Ad is the 30th. I am not sure I counted it right.
lastCol1 = WS1.Cells(i, Columns.Count).End(xlToLeft).Column
lastCol2 = WS2.Cells(j, Columns.Count).End(xlToLeft).Column
rowWS3 = rowWS3 + 1
for col = 1 to lastCol1
WS3.Cells(rowWS3, col) = WS1.Cells(i,col)
next col
rowWS3 = rowWS3 + 1
for col = 1 to lastCol2
WS3.Cells(rowWS3, col) = WS2.Cells(j,col)
next col
end if
next j
next i
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.