VBA - Copying and pasting data from one document to another

Martin_Angosto 

Closing and opening workbooks is relatively slow. Try this:

Sub TransferData()
    Dim CBDOriginalPath As String
    Dim PBDClientePath As String
    Dim CBDOriginalWB As Workbook
    Dim PBDClienteWB As Workbook
    Dim CBDOriginalWS As Worksheet
    Dim PBDClienteWS1 As Worksheet
    Dim PBDClienteWS2 As Worksheet
    Dim ProductRange As Range
    Dim LastRowCBDOriginal As Long
    Dim LastRowPBDCliente1 As Long
    Dim LastRowPBDCliente2 As Long
    Dim ProductRef As Range
    Dim CopyCounter As Integer
    Dim SourceRow1 As Range
    Dim SourceRow2 As Range
    Dim Destination1 As Range
    Dim Destination2 As Range

    Application.ScreenUpdating = False

    ' Get the paths of CBD Original and PBD Cliente files
    CBDOriginalPath = ThisWorkbook.Path & "\CBD Original.xlsm"
    PBDClientePath = ThisWorkbook.Path & "\PBD Cliente.xlsm"

    ' Open the workbooks
    Set CBDOriginalWB = Workbooks.Open(CBDOriginalPath)
    Set PBDClienteWB = Workbooks.Open(PBDClientePath)

    ' Set worksheets
    Set CBDOriginalWS = CBDOriginalWB.Sheets("Plantilla CBD")
    Set PBDClienteWS1 = PBDClienteWB.Sheets(CBDOriginalWS.Range("E8").Value)
    Set PBDClienteWS2 = PBDClienteWB.Sheets(CBDOriginalWS.Range("N8").Value)

    ' Find last row with data
    LastRowCBDOriginal = CBDOriginalWS.Cells(CBDOriginalWS.Rows.Count, "B").End(xlUp).Row
    ' Set product range
    Set ProductRange = CBDOriginalWS.Range("B10:B" & LastRowCBDOriginal)

    ' Initialize copy counter
    CopyCounter = 1

    ' Loop through product range to find "NE" or "N"
    For Each ProductRef In ProductRange
        If ProductRef.Value = "NE" Or ProductRef.Value = "N" Then
            ' Clear data rows from PBD sheets
            LastRowPBDCliente1 = PBDClienteWS1.Cells(PBDClienteWS1.Rows.Count, "B").End(xlUp).Row
            If LastRowPBDCliente1 >= 3 Then
                PBDClienteWS1.Range("B3:E" & LastRowPBDCliente1).ClearContents
                PBDClienteWS1.Range("H3:H" & LastRowPBDCliente1).ClearContents
            End If
            LastRowPBDCliente2 = PBDClienteWS2.Cells(PBDClienteWS2.Rows.Count, "B").End(xlUp).Row
            If LastRowPBDCliente2 >= 3 Then
                PBDClienteWS2.Range("B3:C" & LastRowPBDCliente2).ClearContents
                PBDClienteWS2.Range("F3:I" & LastRowPBDCliente2).ClearContents
            End If
            Set Destination1 = PBDClienteWS1.Range("B3")
            Set Destination2 = PBDClienteWS2.Range("B3")
        End If

        Set SourceRow1 = ProductRef.Offset(0, 3).Resize(1, 4)
        Set SourceRow2 = ProductRef.Offset(0, 9)
        If WorksheetFunction.CountA(Union(SourceRow1, SourceRow2)) > 0 Then
            ' Transfer data for Tab 1
            SourceRow1.Copy Destination:=Destination1
            SourceRow2.Copy Destination:=Destination1.Offset(0, 6)
            Set Destination1 = Destination1.Offset(1)
        End If

        Set SourceRow1 = ProductRef.Offset(0, 12).Resize(1, 2)
        Set SourceRow2 = ProductRef.Offset(0, 16).Resize(1, 4)
        If WorksheetFunction.CountA(Union(SourceRow1, SourceRow2)) > 0 Then
            ' Transfer data for Tab 2
            SourceRow1.Copy Destination:=Destination2
            SourceRow2.Copy Destination:=Destination2.Offset(0, 4)
            Set Destination2 = Destination2.Offset(1)
        End If

        Select Case ProductRef.Offset(1).Value
            Case "NE", "N", ""
                ' Save PBD Cliente workbook with unique name
                PBDClienteWB.SaveAs Filename:=ThisWorkbook.Path & "\PBD Cliente_" & Format(Now(), "yyyymmdd_hhmmss") & "_" & CopyCounter & ".xlsx", FileFormat:=51
                CopyCounter = CopyCounter + 1
        End Select
    Next ProductRef

    ' Close workbooks without saving changes
    CBDOriginalWB.Close SaveChanges:=False
    PBDClienteWB.Close SaveChanges:=False

    Application.ScreenUpdating = True

    MsgBox "Data transfer completed successfully.", vbInformation
End Sub