Copying data from one Workbook to another workbook

Question

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):

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):

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.

Answer 1

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

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.

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

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

Answer 2

may be I didn't get your exact goal (the title is about copy between workbooks but your explanation doesn't mention different workbooks and deals with different worksheets only) but here comes a "metacode" I think you can follow to reach it

Option Explicit

Sub CopyPaste()
Dim wb1 As Workbook, wb2 As Workbook
Dim shtConso As Worksheet, sht01 As Worksheet, sht As Worksheet
Dim ARng As Range, consoRng As Range, cell As Range
Dim LastRow As Long

Set wb1 = ThisWorkbook      '<== set the workbook where "conso" and "Sheet01" sheets are. here I assume the marco will reside in wb1
Set wb2 = Workbooks("wb2")  '<== set the workbook where data are to be possibly pasted. it has to be already open at the time this macro runs

Set shtConso = wb1.Worksheets("conso") 'set the "conso" sheet, where there are data to be possibly copied
Set sht01 = wb1.Worksheets("Sheet01") 'set the "Sheet01" sheet, where there are wb2 sheet names

Set ARng = sht01.  ... ' set the range in "Sheet01" with wb2 sheets names
Set consoRng = shtConso.   ...'set the range in "conso" with wb2 sheets names

For Each cell In ARng 'loop through sheet names to be found in wb2

    Set sht = SetSheet(wb2, cell.Value) 'search for wb2 sheet. see the function skeleton below
    If Not sht Is Nothing Then ' if found '....

        LastRow = GetLastRow(sht, 1) '... get its last non empty row in column A. see the function skeleton below

        With consoRng
            .AutoFilter .... 'now use .Autofilter method on "consoRng" range to select rows that matches cell.Value
            With .SpecialCells(xlCellTypeVisible) ' consider only filtered rows
                ' check if there are any... maybe using a "Find" method on this filtered range

                ' ... and if there are, copy the entire row (use .EntireRow property on the filtered range) and paste them to wb2sheet (use wb2 and lastRow variables)
            End With
            .AutoFilter ' disable autofilter to have the entire range still available
        End With
    End If
Next

End Sub


Function SetSheet(wb As Workbook, shtName As String) As Worksheet
' write a simple function that that try and set a sheet with the given name in the given workbook
' if it succeed it returns that sheet
' if it fails then it returns "nothing"

End Function


Function GetLastRow(sht As Worksheet, col As Long) As Long
' write a simple function that returns the row of the last non empty cell of the given column in the given worksheet
' use ".End(xlUp)" method of the "Range" object
' handle the cases where either the column has no values or its last non empty cell is in the very last row of that column

End Function