[英]VBA copying data from one workbook to specific cells in another, based on criteria
I have 2 workbooks and need to copy over data from rows that have a "yes" in the 26th column to specific cells in the destination workbook.我有 2 个工作簿,需要将第 26 列中为“是”的行中的数据复制到目标工作簿中的特定单元格。 I currently have the following code attached to a button on the source sheet:
我目前将以下代码附加到源表上的按钮上:
Sub exportData()
Dim LastRow As Integer
Dim i As Integer
Dim erow As Integer
LastRow = ActiveSheet.Range("A" & rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Cells(i, 26).Value = "Yes" Then
Range(Cells(i, 1), Cells(i, 26)).Select
Selection.Copy
Workbooks.Open Filename:=ThisWorkbook.Path & "\GI New Starter Tracker 2017edit.xlsx"
Worksheets("Main").Select
erow = ActiveSheet.Cells(rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
'ActiveSheet.Range("$A$1:$AB$3000").RemoveDuplicates Columns:=2, Header:=xlYes
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.CutCopyMode = False
End If
Next i
End Sub
The code works fine, however it copies over the entire row, but I only need to copy over certain information like "firstname", "Surname" "Date of birth".代码工作正常,但是它复制了整行,但我只需要复制某些信息,如“名字”、“姓氏”、“出生日期”。 The target workbook doesnt have exactly the same headings so I need to be able to specify which column.
目标工作簿没有完全相同的标题,所以我需要能够指定哪一列。
Ive been pulling my hair out and would really appreciate any help.我一直在拉我的头发,非常感谢任何帮助。
Thanks :)谢谢 :)
This should do it.这应该这样做。 You'll need to change the column number to the corresponding columns in your workbooks....
您需要将列号更改为工作簿中的相应列....
Sub exportData()
Dim LastRow As Integer
Dim i As Integer
Dim erow As Integer
Dim wbk As Workbook
Dim SourceSheet As Worksheet
Dim DestSheet As Worksheet
Dim firstName, surName, DoB
Set SourceSheet = ActiveSheet
LastRow = SourceSheet.Range("A" & Rows.Count).End(xlUp).Row
Set wbk = Workbooks.Open(ThisWorkbook.Path & "\GI New Starter Tracker 2017edit.xlsx")
Set DestSheet = wbk.Sheets("Main")
For i = 2 To LastRow
If SourceSheet.Cells(i, 26).Value = "Yes" Then
'change the column numbers to the relevant number
firstName = SourceSheet.Cells(i, 23).Value
surName = SourceSheet.Cells(i, 24).Value
DoB = SourceSheet.Cells(i, 25).Value
erow = DestSheet.Cells(DestSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
'change the column numbers to the relevant number
DestSheet.Cells(erow, 10).Value = firstName
DestSheet.Cells(erow, 11).Value = surName
DestSheet.Cells(erow, 12).Value = DoB
End If
Next i
wbk.Save
wbk.Close
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.