Forum Discussion
VBA - Copying and pasting data from one document to another
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
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?
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 SubIt 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?
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?
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.