将数据从一个工作簿复制到另一个工作簿 [英] Copying data from one Workbook to another workbook

问题描述

我在VBA中做了一些复制粘贴功能。如果单元格A1 中的值与其他工作簿中的值匹配，则必须复制整行。让我们说（表名：Sheet1）：

I'm doing some copy-paste functionality in VBA. I have to copy the entire row if the value in cell A1 matches with the value in the other workbook. Let's say (Sheet name is : Sheet1):

在此工作表中，单元格中的所有值都是工作簿的工作表名称。所以从这本书中我有这个数据（表名：conso）：

In this sheet, all the values in the cell is the sheet name of the workbook. So from this work book, I have this data (sheet name: conso):

所以我想做的是找到与单元格值匹配的 RangeA 中的所有值。例如：如果 Sheet1 中的列A 值与列A Conso 中的code>，那么我必须复制整个行，然后将其粘贴到工作表中，这是 sheetName 与$ code> Sheet1 中的列A 中的值相匹配。感谢提前。

So what I want to do is to find all the values in RangeA that matches with the Cell values. For example: if Column A in Sheet1 values matches with the value in Column A in Conso, then I have to copy the entire row and paste it in the sheet which is the sheetName matches with the value in Column A of Sheet1. Thanks in advance.

推荐答案

很多人在我的代码中尝试解释，但我相信它完全符合你的要求。 p>

Alot to try an explain in my code, but I believe it does exactly what you asked.

 Option Explicit
 Sub CopyDataFromOneWorkBookToAnother()
      'Setting up Reference to the Data WorkSheet
      Dim DataBaseSheet As Worksheet
      Set DataBaseSheet = Workbooks("Database WorkBook.xlsx").Sheets("conso")

      'Setting up Reference to the OtherWorkBook
      Dim SearchCriteriaSheet As Worksheet
      Set SearchCriteriaSheet = Workbooks("BookName.xlsm").Sheets("Sheet1")

      Dim LastRowSearchCriteria As Long
      LastRowSearchCriteria = SearchCriteriaSheet.Cells(SearchCriteriaSheet.Rows.Count, "A").End(xlUp).Row

      Dim SearchCriteriaRange As Range
      SearchCriteriaSheet.Activate
      Set SearchCriteriaRange = SearchCriteriaSheet.Range(Cells(1, "A"), Cells(LastRowSearchCriteria, "A"))


      Dim SearchValue As Range
      Dim SingleSearchCriteria As String
      Dim DataBaseFoundRange As Range
      Dim SearchRange As Range
      Dim FoundDataRowReference As Range
      Dim SingleFoundRange As Range
      Dim LastColumInFoundDataRow As Long
      Dim PastedRowCounter As Long
      Dim LastCellofSearchRange As Range
      Dim FirstAddress As String


      For Each SearchValue In SearchCriteriaRange

           SingleSearchCriteria = SearchValue.Value

           DataBaseSheet.Activate
           Set SearchRange = DataBaseSheet.Columns("A:A")

           'For use in the .Find After:=
           'This enables the search to start at the Top of the Column
           'Otherwise it skips the initial cell
           With SearchRange
                Set LastCellofSearchRange = .Cells(.Cells.Count)
           End With

           Set DataBaseFoundRange = SearchRange.Find(what:=SingleSearchCriteria, After:=LastCellofSearchRange, _
                                                     LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
                                                     SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

           'To reference the row to paste the data to
           PastedRowCounter = 1

           'Setting the First Found address in order to know when to quit the Loop
           If Not DataBaseFoundRange Is Nothing Then
                FirstAddress = DataBaseFoundRange.Address
           End If


           Do Until DataBaseFoundRange Is Nothing

                LastColumInFoundDataRow = DataBaseSheet.Cells(DataBaseFoundRange.Row, Columns.Count).End(xlToLeft).Column
                Set SingleFoundRange = DataBaseSheet.Range(Cells(DataBaseFoundRange.Row, "B"), Cells(DataBaseFoundRange.Row, LastColumInFoundDataRow))
                SingleFoundRange.Copy
                Workbooks("BookName.xlsm").Sheets(DataBaseFoundRange.Value).Cells(PastedRowCounter, "A").PasteSpecial Paste:=xlPasteValues


                Set DataBaseFoundRange = SearchRange.FindNext(After:=DataBaseFoundRange)
                If DataBaseFoundRange.Address = FirstAddress Then
                     Exit Do
                End If

                PastedRowCounter = PastedRowCounter + 1
           Loop

      Next SearchValue

End Sub

使用搜索条件快速搜索WorkBook，这也是粘贴了B1，B2等表格的工作簿。

Snap shot of the WorkBook with the search Criteria and this is also the workbook in which the data will be pasted which had the "B1", "B2" , etc sheets.

DataBase的快照列A中的B1，B2参考的工作簿

Snapshot of the "DataBase" workbook with the B1, B2 reference in Column A

下面的代码的结果，其中列A中具有B1的行中的数据基于Sheet B1，然后是第一个B2等等。

Result of the code seen below, where the Data in rows with B1 in Column A are based into Sheet B1 and then sam eiwth B2, etc etc

这篇关于将数据从一个工作簿复制到另一个工作簿的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！