VBA to transfer data from one workbook to another

[Robert_Conklin]

I have this particular piece of code that transfer data from a source workbook to a repository workbook. The problem that I am having is that it will not post the data to the bottom of the list. It overwrites the top rows of data. I have tried setting up tables on the destination workbook, but that did not work. All of the other code that transfers data between the two workbooks works perfectly and is set up the exact same way. Does anyone have any suggestions?

Below is the piece of code:

sLR = .Range("A" & Rows.Count).End(xlUp).Row dLR = dAE.Range("A" & Rows.Count).End(xlUp).Row + 1
.Range(.Cells(2, "E"), .Cells(sLR, "E")).Copy Destination:=dEXT.Range("A" & dLR)
.Range(.Cells(2, "C"), .Cells(sLR, "C")).Copy Destination:=dEXT.Range("B" & dLR)
.Range(.Cells(2, "G"), .Cells(sLR, "G")).Copy Destination:=dEXT.Range("C" & dLR)
.Range(.Cells(2, "J"), .Cells(sLR, "J")).Copy Destination:=dEXT.Range("D" & dLR)
.Range(.Cells(2, "T"), .Cells(sLR, "T")).Copy Destination:=dEXT.Range("E" & dLR)
.Range(.Cells(2, "K"), .Cells(sLR, "K")).Copy Destination:=dEXT.Range("F" & dLR)
.Range(.Cells(2, "U"), .Cells(sLR, "U")).Copy Destination:=dEXT.Range("G" & dLR)
.Range(.Cells(2, "V"), .Cells(sLR, "V")).Copy Destination:=dEXT.Range("H" & dLR)
.Range(.Cells(2, "H"), .Cells(sLR, "H")).Copy Destination:=dEXT.Range("I" & dLR)

 

[NdNoviceHlp]

A guess...

dLR = dEXT.Range("A" & Rows.Count).End(xlUp).Row + 1

or....

.Range(.Cells(2, "E"), .Cells(sLR, "E")).Copy Destination:=dAE.Range("A" & dLR)

HTH. Dave

 

[mumps]

Try:

Destination:=dEXT.cells(rows.Count,"A").end(xlup).offset(1,0)
Destination:=dEXT.cells(rows.Count,"B").end(xlup).offset(1,0)

etc.

 

[Robert_Conklin]

Thank you gentlemen!! I have been playing around for 3 weeks trying to figure out what was happening. Mumps, your code worked beautifully! Thank you both for the responses!!

 

[mumps]

You are very welcome.

 

[Robert_Conklin]

I have added another worksheet to my project called RAW DATA. The current code I am using (see below) currently transfers data from one worksheet (ADD EXTEND)to two other worksheets (BASIC AND 4X4) in another workbook. The data that is sent to the BASIC worksheet is sent on a condition that if the INDICATE ACTION is "ADD". On the other hand, the required data for the 4X4 worksheet has to post three times, one for each valuation (PM_NEW, PM-USED, and PM-REBUILT). I would like to incorporate code into my existing code to transfer data in the same fashion from the RAW DATA worksheet (source) to the same two sheets in the destination workbook.

Option ExplicitPublic Sub Compile_Basic_4x4(sWB As Workbook, sWS As Worksheet, dWB As Workbook, dBASIC As Worksheet, d4x4 As Worksheet)


Dim rng As Range, _
sLR As Long


Dim tSAPNum As String, _
tSAPDesc As String, _
tUOM As String, _
tMatGrp As String, _
tPlant As String


Dim LRBasic As Long, _
LR4x4 As Long


Dim ARR4x4 As Variant


ARR4x4 = Array("PM-NEW", "PM-USED", "PM-REBUILT")


sLR = sWS.Range("D" & Rows.Count).End(xlUp).Row


For Each rng In sWS.Range("D2:D" & sLR)
tSAPNum = sWS.Range("E" & rng.Row).Value
tSAPDesc = sWS.Range("R" & rng.Row).Value
tUOM = sWS.Range("I" & rng.Row).Value
tMatGrp = sWS.Range("W" & rng.Row).Value
tPlant = sWS.Range("C" & rng.Row).Value
Select Case UCase(rng.Value)
Case "ADD"
With dBASIC
LRBasic = .Range("A" & Rows.Count).End(xlUp).Row + 1
With .Range("A" & LRBasic)
.Value = tSAPNum
.Offset(0, 1).Value = tSAPDesc
.Offset(0, 2).Value = tUOM
.Offset(0, 3).Value = tMatGrp
End With
End With
With d4x4
LR4x4 = .Range("A" & Rows.Count).End(xlUp).Row + 1
With .Range("A" & LR4x4)
.Resize(3, 1).Value = tSAPNum
.Offset(0, 1).Resize(3, 1).Value = tPlant
.Offset(0, 2).Resize(3, 1).Value = Application.Transpose(ARR4x4)
End With
End With
Case "EXTEND"
With d4x4
LR4x4 = .Range("A" & Rows.Count).End(xlUp).Row + 1
With .Range("A" & LR4x4)
.Resize(3, 1).Value = tSAPNum
.Offset(0, 1).Resize(3, 1).Value = tPlant
.Offset(0, 2).Resize(3, 1).Value = Application.Transpose(ARR4x4)
End With
End With
Case Else
'Do Nothing
End Select
Next rng


End Sub

 

[mumps]

In the "RAW DATA" sheet, there are no SAP numbers for those rows that have "Add" in column B so the macro would copy blank cells. Is that OK? Also, for the 4 X 4 sheet, do you want Column C "SAP #" and Column G "PLANT" only for those rows that contain "Add" in column B or for all the row?

 

[Robert_Conklin]

Yes, it is fine that it transfers blank cells, as long as it will transfer the SAP #s if they are in there. Also, for the 4 X4, every line item needs to transfer, not just the adds. The Basic sheet is only for the "ADDs" The Extend and the 4 X 4 are for every line item. I have already manipulated the Extend code to transfer data from the "RAW DATA" tab.

 

[mumps]

Make "RAW DATA" the activesheet and run this macro. Both workbooks must be open:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim bottomA As Long
    Dim bottomC As Long
    Dim desWB As Workbook
    Set desWB = Workbooks("SPAR LOAD PROCESS WORKSHEET 2017.xlsx")
    ActiveSheet.ListObjects("RAWDATA").Range.AutoFilter Field:=2, Criteria1:="Add"
    Range("C2:F" & LastRow).SpecialCells(xlCellTypeVisible).Copy desWB.Sheets("BASIC").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
    Range("C2:C" & LastRow).Copy desWB.Sheets("4X4 EXTEND").Cells(desWB.Sheets("4X4 EXTEND").Rows.Count, "A").End(xlUp).Offset(1, 0)
    Range("G2:G" & LastRow).Copy desWB.Sheets("4X4 EXTEND").Cells(desWB.Sheets("4X4 EXTEND").Rows.Count, "B").End(xlUp).Offset(1, 0)
    bottomC = desWB.Sheets("4X4 EXTEND").Range("C" & desWB.Sheets("4X4 EXTEND").Rows.Count).End(xlUp).Row + 1
    bottomA = desWB.Sheets("4X4 EXTEND").Range("A" & desWB.Sheets("4X4 EXTEND").Rows.Count).End(xlUp).Row
    desWB.Sheets("4X4 EXTEND").Range("C" & bottomC & ":C" & bottomA) = "PM-NEW"
    Range("C2:C" & LastRow).Copy desWB.Sheets("4X4 EXTEND").Cells(desWB.Sheets("4X4 EXTEND").Rows.Count, "A").End(xlUp).Offset(1, 0)
    Range("G2:G" & LastRow).Copy desWB.Sheets("4X4 EXTEND").Cells(desWB.Sheets("4X4 EXTEND").Rows.Count, "B").End(xlUp).Offset(1, 0)
    bottomC = desWB.Sheets("4X4 EXTEND").Range("C" & desWB.Sheets("4X4 EXTEND").Rows.Count).End(xlUp).Row + 1
    bottomA = desWB.Sheets("4X4 EXTEND").Range("A" & desWB.Sheets("4X4 EXTEND").Rows.Count).End(xlUp).Row
    desWB.Sheets("4X4 EXTEND").Range("C" & bottomC & ":C" & bottomA) = "PM-USED"
    Range("C2:C" & LastRow).Copy desWB.Sheets("4X4 EXTEND").Cells(desWB.Sheets("4X4 EXTEND").Rows.Count, "A").End(xlUp).Offset(1, 0)
    Range("G2:G" & LastRow).Copy desWB.Sheets("4X4 EXTEND").Cells(desWB.Sheets("4X4 EXTEND").Rows.Count, "B").End(xlUp).Offset(1, 0)
    bottomC = desWB.Sheets("4X4 EXTEND").Range("C" & desWB.Sheets("4X4 EXTEND").Rows.Count).End(xlUp).Row + 1
    bottomA = desWB.Sheets("4X4 EXTEND").Range("A" & desWB.Sheets("4X4 EXTEND").Rows.Count).End(xlUp).Row
    desWB.Sheets("4X4 EXTEND").Range("C" & bottomC & ":C" & bottomA) = "PM-REBUILT"
    Application.ScreenUpdating = True
End Sub

 

[Robert_Conklin]

Where did you place your code, the mBASIC_4x4 module? What about the code that was already there? It transferred data from another source worksheet to the same destination worksheets?