如果满足条件/条件,则将数据复制到其他工作簿

对不起,如果这已经被问了很多次。 我是一名vba excel的初学者,所以我只是简单介绍一下如何开始代码。 我正在使用Excel 2013。

我有2个不同的工作簿,主要和副本。 第1行到第4行将是空的。 第5行是用于标题/标记它将提供给两个工作簿的信息。

“主”工作簿将使用列A到DN来存储所有的数据。

如果单元格包含“X” – 它将A列复制到P,工作簿“复制”。 之后,它会继续下一行来确定相同的事情。 如果单元格是空的,它将继续下一行以确定相同的东西。 代码必须是dynamic的,因为每3个月会添加一个新的信息,例如添加新的行或者从“X”变为空,或空变为“X”的标准。

这是我现在得到的代码。 它的工作原理,但由于有太多的列检查通过,我被build议为此做另一个代码。

Sub copy() Dim lr As Long, lr2 As Long, r As Long lr = Sheets("main").Cells(Rows.Count, "A").End(xlUp).row lr2 = Sheets("copy").Cells(Rows.Count, "A").End(xlUp).row For r = lr To 2 Step -1 If range("Q" & r).Value = "X" Then Rows(r).copy Destination:=Sheets("copy").range("A" & lr2 + 1) lr2 = Sheets("copy").Cells(Rows.Count, "A").End(xlUp).row End If Next r End Sub 

为此,您将必须声明两个工作簿variables和两个工作表variables,以在代码中保存源和目标工作簿和工作表引用。

按照您的要求调整以下代码。

我已经在代码中添加了注释,这将有助于您理解程序的stream程。

此外,可以使用更多的error handling来确保源和目标工作表分别在源工作簿和目标工作簿中find。 如果需要,您也可以添加error handling。

 Option Explicit Sub CopyDatoToAnotherWorkbook() Dim srcWB As Workbook, destWB As Workbook 'Variables to hold the source and destination workbook Dim srcWS As Worksheet, destWS As Worksheet 'Variables to hold the source and destination worksheets Dim FilePath As String 'Variable to hold the full path of the destination workbook including it's name with extension Dim lr As Long, lr2 As Long, r As Long Application.ScreenUpdating = False Set srcWB = ThisWorkbook 'Setting the source workbook Set srcWS = srcWB.Sheets("main") 'Setting the source worksheet 'Setting the FilePath of the destination workbook 'The below line assumes that the destination file's name is MyFile.xlsx and it is saved at your desktop. Change the path as per your requirement FilePath = Environ("UserProfile") & "\Desktop\MyFile.xlsx" 'Cheching if the destination file exists, it yes, proceed with the code else EXIT If Dir(FilePath) = "" Then MsgBox "The file " & FilePath & " doesn't exist!", vbCritical, "File Not Found!" Exit Sub End If 'Finding the last row used in column A on source worksheet lr = srcWS.Cells(Rows.Count, "A").End(xlUp).Row 'Opening the destination workbook and setting the source workbook Set destWB = Workbooks.Open(FilePath) 'Setting the destination worksheet Set destWS = destWB.Sheets("copy") 'Looping through rows on source worksheets For r = lr To 2 Step -1 'Finding the first empty row in column A on destination worksheet lr2 = destWS.Cells(Rows.Count, "A").End(xlUp).Row + 1 If srcWS.Range("Q" & r).Value = "X" Then srcWS.Rows(r).copy Destination:=destWS.Range("A" & lr2 + 1) End If Next r 'Closing the destination workbook destWB.Close True Application.CutCopyMode = False Application.ScreenUpdating = True End Sub