Coping multiple sheets from another workbook to 1 worksheet in current workbook

[mssbass]

Code below is working but once it pastes the first worksheet data, it deletes it then pastes the 2nd worksheets data. I need it to paste the 2nd worksheets data below the first.

Sub ImportECINS()

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long

StrDate1 = Format(Date - 1, "yyyy")
StrDate2 = Format(Date - 1, "yyyy") & "-" & Format(Date - 1, "mm") & "-" & Format(Date - 1, "dd")

Application.DisplayAlerts = False
Workbooks.Open ("\\abc\Shares\Files\Data\ECINS\" & StrDate1 & "\" & "ECINS_" & StrDate2 & ".xlsx")


Set wsDest = Workbooks("Fax Daily Closed Report Template.xlsm").Worksheets("ECIN Closed Report")
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "F").End(xlUp).Offset(1).Row

wsDest.Range("D2:DV" & lDestLastRow).ClearContents

For Each wsCopy In Workbooks("ECINS_" & StrDate2 & ".xlsx").Worksheets
wsCopy.Range("A2:DS" & Cells(Rows.Count, 1).End(xlUp).Row).Copy _
wsDest.Range("D2")
Next wsCopy

End Sub

 

[Trebor76]

Hi mssbass,

Untested but see how replacing this line...

wsCopy.Range("A2:DS" & Cells(Rows.Count, 1).End(xlUp).Row).Copy _
wsDest.Range("D2")

...with this goes:

wsCopy.Range("A2:DS" & wsCopy.Cells(Rows.Count, 1).End(xlUp).Row).Copy Destination:=wsDest.Range("D" & wsDest.Cells(wsDest.Rows.Count, "D").End(xlUp).Offset(1).Row)

Regards,

Robert