John.McLaughlin
Board Regular
- Joined
- Jul 19, 2011
- Messages
- 169
Hello,
I sell goods and services, and keep a table by part no of each item needed to complete the order – “the packing list”. It works great if there is only one item sold.
When there are multiple items on the order, I need to combine the table into a single column.
Here is the full code. It keeps pasting the columns instead of finding the last empty row in Column A
Thanks in advance!
I sell goods and services, and keep a table by part no of each item needed to complete the order – “the packing list”. It works great if there is only one item sold.
When there are multiple items on the order, I need to combine the table into a single column.
Here is the full code. It keeps pasting the columns instead of finding the last empty row in Column A
Thanks in advance!
Code:
Sub PostPackingList()
' PackingListPost - post from OPEN ORDER PackingList SS to Scheduled PackingList SS
'
'
' Copy items to sheet.
'
'
Application.ScreenUpdating = False
Dim wbTarget As Workbook 'workbook where the data is to be pasted SCHEDULED:PackingList
Dim wbThis As Workbook 'workbook from where the data is to copied Open Order"PackingList
Dim strName As String 'name of the source sheet/ target workbook
Dim filelink As String ' name of workbook
Dim targetFile As String
' ----------------- Find last row
Dim DstRng As Range
Dim DstWks As Worksheet
Dim LastRow As Long
Dim N As Long, r As Long
Dim SrcRng As Range
Dim SrcWks As Worksheet
' ------------------ End find last row
'set to the current active workbook (the source book is the Open Order)
Set wbThis = ActiveWorkbook
'get the active sheetname of the Open Order workbook
strName = ActiveSheet.Name
' Activate the Scheduled Workbook and select the PackingList worksheet
Workbooks("SCHEDULED.xlsm").Activate
Set wbTarget = ActiveWorkbook
Sheets("PackingList").Select
'activate the Open Order source book
wbThis.Activate
' copy the range from source book
wbThis.Sheets("PackingList").Range("A5:Z5").Copy
' Assign the Worksheets
Set SrcWks = wbThis.Sheets("PackingList")
Set DstWks = wbTarget.Sheets("PackingList")
' Get all cells in the Source Range starting with row 5
Set SrcRng = SrcWks.Range("A5:Z5")
LastRow = SrcWks.Cells(Rows.Count, "B").End(xlUp).Row
If LastRow < SrcRng.Row Then Exit Sub Else Set SrcRng = SrcRng.Resize(LastRow - SrcRng.Row + 1, 26)
' Find the next empty row in the Destination Range starting at row 3
Set DstRng = DstWks.Range("A3:A3")
LastRow = DstWks.Cells(Rows.Count, "A").End(xlUp).Row
Set DstRng = IIf(LastRow < DstRng.Row, DstRng, DstRng.Offset(LastRow - DstRng.Row + 1, 0))
' Copy the Source cells to the next empty Destination row if the Source Cell in "A" is not empty
For r = 1 To SrcRng.Rows.Count
If SrcRng.Cells(r, "A") <> "" Then
DstRng.Offset(N, 0).Resize(, 5).Value = SrcRng.Rows(r).Value
N = N + 1
End If
Next r
'save the target book
wbTarget.Save
'activate the source book again
wbThis.Activate
Sheets("ORDER").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
Range("A1").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Set wbTarget = Nothing
Set wbThis = Nothing
End Sub
)
