VBA - Copying and pasting data from one document to another

[Martin_Angosto]

Hello VBA experts,

Running Excel 365. A little bit of context:

I have an original Excel file named CBD Original. In this file, there is a range (B10:B25) with product references. For each reference that is "NE" and/or "N" my code opens the other excel file that is located in the same folder as the current Excel file and that is named "PBD Cliente", pastes data from CBD Original file based on some ranges that simulate the two different tabs of the PBD file and finally saves a copy of it.

I have already played around with the code in order to create this functionality. All you have to do is to put both attached files in a folder, open the CBD Original file and then run the macro.

The problem is the following: PBD file has its sheets protected. Specifically, blue "columns" are locked and values cannot be entered in those cells. I already know that (note that blue "columns" in the CBD Original file are empty because I know I should not paste any values there) but I do not know how to rearrange the code in order to understand that. As per now, the code simply copies row by row entirely and tries to paste it on the other file, which results breaking the whole automation because certain cells cannot be pasted (even if they are already blank). Run-time error 1004 occurs.

The attached PBD file does not have its sheet protected so that you can see the functionality working correctly. Please protect its sheets and make sure only blue columns are the ones unable to receive data when trying to propose a solution.

I hope anyone could give me a hand with this.

Martin

[#2]

@Martin_Angosto 

I don't understand why you are using nested loops. Does this do what you want?

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 LastRowPBDCliente1 As Long
    Dim LastRowPBDCliente2 As Long
    Dim ProductRef As Range
    Dim CopyCounter As Integer
    Dim DataRange As Range
    Dim SourceRow1 As Range
    Dim SourceRow2 As Range
    Dim Destination1 As Range
    Dim Destination2 As Range

    ' 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 rows with data
    LastRowPBDCliente1 = PBDClienteWS1.Cells(PBDClienteWS1.Rows.Count, "B").End(xlUp).Row
    LastRowPBDCliente2 = PBDClienteWS2.Cells(PBDClienteWS2.Rows.Count, "B").End(xlUp).Row

    ' Set product range
    Set ProductRange = CBDOriginalWS.Range("B10:B25")

    ' 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
            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
                LastRowPBDCliente1 = LastRowPBDCliente1 + 1
                Set Destination1 = PBDClienteWS1.Range("B" & LastRowPBDCliente1)
                SourceRow1.Copy Destination:=Destination1
                SourceRow2.Copy Destination:=Destination1.Offset(0, 6)
            End If

            Set SourceRow1 = ProductRef.Offset(0, 13).Resize(1, 2)
            Set SourceRow2 = ProductRef.Offset(0, 17).Resize(1, 4)
            If WorksheetFunction.CountA(Union(SourceRow1, SourceRow2)) > 0 Then
                ' Transfer data for Tab 2
                LastRowPBDCliente2 = LastRowPBDCliente2 + 1
                Set Destination2 = PBDClienteWS2.Range("B" & LastRowPBDCliente2)
                SourceRow1.Copy Destination:=Destination2
                SourceRow2.Copy Destination:=Destination2.Offset(0, 4)
            End If

            ' 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 If
    Next ProductRef

    ' Close workbooks without saving changes
    CBDOriginalWB.Close False
    PBDClienteWB.Close True

    MsgBox "Data transfer completed successfully."
End Sub

[#3]

@Hans Vogelaar 

My knowledge of VBA is limited to kindly understand code and edit it when necessary + writing simple VBA. So I used AI to set up a basis for this. I then started to play around. The nested loop is for 1) do the whole procedure as many times as "N" or "NE" is found in the product reference range and 2) look through every single row in each of the two data ranges, find non-blank rows and then continue with the procedure of copying and pasting. My intention also was to paste all rows consecutively (see first picture I will attach) and not with empty spaces like in CBD file.

I have tried your code and it does not return any error (even if I protect the sheets of PBD file, which at least seems advancement). The thing is that the output is, to my great regret, nowhere near the desired. Have you run my code without protecting the sheets of PBD, just as they are attached? The output looks as follows (for instance, for the blue tab):

Which perfectly matches the structure and is in line with the CBD Original file:

However, with your proposal:

Note that Part Name in the first row should be "This" and not "123".

Any other suggestions? Am I getting something wrong?

[#4]

@Martin_Angosto 

My apologies, I used an incorrect offset.

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 LastRowPBDCliente1 As Long
    Dim LastRowPBDCliente2 As Long
    Dim ProductRef As Range
    Dim CopyCounter As Integer
    Dim DataRange As Range
    Dim SourceRow1 As Range
    Dim SourceRow2 As Range
    Dim Destination1 As Range
    Dim Destination2 As Range

    ' 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 rows with data
    LastRowPBDCliente1 = PBDClienteWS1.Cells(PBDClienteWS1.Rows.Count, "B").End(xlUp).Row
    LastRowPBDCliente2 = PBDClienteWS2.Cells(PBDClienteWS2.Rows.Count, "B").End(xlUp).Row

    ' Set product range
    Set ProductRange = CBDOriginalWS.Range("B10:B25")

    ' 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
            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
                LastRowPBDCliente1 = LastRowPBDCliente1 + 1
                Set Destination1 = PBDClienteWS1.Range("B" & LastRowPBDCliente1)
                SourceRow1.Copy Destination:=Destination1
                SourceRow2.Copy Destination:=Destination1.Offset(0, 6)
            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
                LastRowPBDCliente2 = LastRowPBDCliente2 + 1
                Set Destination2 = PBDClienteWS2.Range("B" & LastRowPBDCliente2)
                SourceRow1.Copy Destination:=Destination2
                SourceRow2.Copy Destination:=Destination2.Offset(0, 4)
            End If

            ' 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 If
    Next ProductRef

    ' Close workbooks without saving changes
    'CBDOriginalWB.Close False
    'PBDClienteWB.Close True

    MsgBox "Data transfer completed successfully."
End Sub

[#5]

@Hans Vogelaar 

It is working!!

Just one thing!

My apologies if my explanation was misleading but I think my description of the problem led you to understand that only rows from "N" or "NE" should be pasted. That is not the case. The "N" or "NE" thing is to count how many copies of the PBD file should the code create. In this case, there should be 5 copies at the end of the whole procedure. But that does not mean that only "N" or "NE" rows should be copied and pasted. All rows should be transfered, independently on their product reference.

Are you so kind to be able to address this on your piece of code?

[#6]

@Martin_Angosto 

I completely misread your original post.

What is the purpose of populating the target worksheet over and over again in the inner loop? Or am I missing something again?

[#7]

@Hans Vogelaar 

Let me first apologize for all the confusion. I tried to summarize and simplify as much as possible the problem and then try to advance the code by myself. But I think it will be better if I explain all at maximum detail.

As I stated in my previous reply, you last piece of code was very good. The drawback: not all the rows were populated in the target PBD file copies. The intention to create as many copies as "N" or "NE" references is as explained by the following (following image is from CBD file):

References "N" or "NE" are references from finished products. For each of the finished products, I need to create a populated copy of the PBD file, as you have already accomplished. These finished products are, some, made by small product parts (A, E and C references). Now, what I need is, following the example above:

- First row, which is NE is a finished product that needs to be populated only in a first copy of the PBD file, populated accordingly.

- Second row, which is N is a finished product that needs to be populated only in a second copy of the PBD file. However, this final product also contains small pieces, note row 3, 4 and 5 also have the string "PBD Copy 2". Therefore, copy 2 of the PBD file needs to be populated with rows 2, 3, 4 and 5.

- The same with the rest of the copies. To illustrate:

This is how PBD file copy 1 should look like (only data in blue tab):

This is how PBD file copy 2 should look like (data in orange tab):

This is how PBC file copy 2 should look like (data in blue tab):

In this case, PBD file copy 3 should be empty as I don't have any data in CBD for it.

This is how both tabs of PBD file copy 4 should look like:

The same idea for copy 5...

As per the code structure you gave me, it was working well addressing the protected sheets issue. I assume it was more a matter of a bad explanation of mine. Are you able to provide a code for this? I would really appreciate it. I already have to thank you for your time with this. I hope you can give me a last hand!

Atttaching the CBD file again with these strings next to product references.

[#8]

@Martin_Angosto 

I have a better idea what you want now, so thanks.

But I'm still confused: your code opens the PBD file only once.

Inside the loop:

(1) add some data,

(2) save the PBD file under a new name,

(3) add some more data,

(4) save the PBD file under another name.

etc. etc.

Shouldn't we either close and reopen the original PBD file after saving the copy, or clear the data that we added after (2), (4) etc.?

[#9]

@Hans Vogelaar 

You are definately so right. My bad. We should close and reopen the original PBD file after saving a copy. If not, only the last operation of pasting will be the one present in all the copies.

[#10]

@Martin_Angosto 

I'll take another look. Have to do some other things first, though.

[#11]

@Martin_Angosto 

Here is a new version.

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("A3:A" & LastRowPBDCliente1).EntireRow.ClearContents
            End If
            LastRowPBDCliente2 = PBDClienteWS2.Cells(PBDClienteWS2.Rows.Count, "B").End(xlUp).Row
            If LastRowPBDCliente2 >= 3 Then
                PBDClienteWS2.Range("A3:A" & LastRowPBDCliente2).EntireRow.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

[#12]

@Hans Vogelaar 

I think we are almost there, Hans! Everything goes where it should go!!

One last thing: If I try to run the code with the PBD file sheets protected it gives me run-time error 1004. Without the sheets protected, the code works like a charm. It is maybe because of the fact that you used: 

If LastRowPBDCliente1 >= 3 Then
                PBDClienteWS1.Range("A3:A" & LastRowPBDCliente1).EntireRow.ClearContents
End If

Since you are selecting the entire row (including protected/blocked cells) and then trying to clear contents, it appears the error message, at least when doing it manually. Could be the source problem? Why don't we try to close and reopen the workbook instead of clearing contents? I don't know, just my thoughts...

[#13 · Accepted solution]

@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

[#14]

@Hans Vogelaar 

I cannot express how grateful I am with all the time you have spent helping me with this. Thank you for your contribution and your great commitment to help.

Martin