Pasting Data to Columns then Come To Next Last Row with VBA

[druva]

Hi

i Have Data in separate workbooks from each workbooks sheet1 copy data(non contiguous cells) and paste it in thisworkbook sheet1 with column wise pasting is completed then open next workbook copy data and paste in select next last row continue column wise.Looking for a code in VBA

header1 header2 header3 header4 header5
a b c d e 1st workbookCellsData
b d f e c 2nd workbookCellsData

Here is my code:
-------------------
Option Explicit


Const FOLDER_PATH = "C:\Users\pc\Desktop\NewProject\New folder\" 'REMEMBER END BACKSLASH


Sub ImportWorksheets()
'=============================================
'Process all Excel files in specified folder
'=============================================
Dim sFile As String 'file to process
Dim wsTarget As Worksheet
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim rowTarget As Long 'output row
Dim lastrow As Integer
Dim wsSheet As Worksheet
'rowTarget = 2
Dim wb As Workbook


'check the folder exists

If Not FileFolderExists(FOLDER_PATH) Then
MsgBox "Specified folder does not exist, exiting!"
Exit Sub
End If

'reset application settings in event of error

On Error GoTo errHandler
Application.ScreenUpdating = False



'loop through the Excel files in the folder

sFile = Dir(FOLDER_PATH & "*.xls*")
Do Until sFile = ""


'open the source file and set the source worksheet - ASSUMED WORKSHEET(1)

Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
Set wsSource = wbSource.Worksheets(1) 'EDIT IF NECESSARY


Dim copyRange As Range, cel As Range, pasteRange As Range, erow As Long, lastCol As Long
'Source file copy range
Set copyRange = ActiveWorkbook.Sheets("Sheet1").Range("B3,B6,B8")

'Destination file
Set pasteRange = ThisWorkbook.Sheets("Sheet2").Range("A1")

'start a looping process to copy and paste non-adjacent cells

For Each cel In copyRange
cel.Copy
lastCol = Sheet2.Cells(1, Columns.Count).End(xlToLeft).Offset(1, 1).Column
pasteRange.Cells(1, lastCol).PasteSpecial xlPasteValues

Next

'remove the ant-like selection

Application.CutCopyMode = False


'close the source workbook, increment the output row and get the next file

wbSource.Close SaveChanges:=False

sFile = Dir()

Loop

errHandler:
On Error Resume Next
Application.ScreenUpdating = True

'tidy up
Set wsSource = Nothing
Set wbSource = Nothing
Set wsTarget = Nothing


End Sub



Any help appreciated.

[Pepe Le Mokko]

Administrative Note:

Welcome to the forum.

We would very much like to help you with your query, however you need to include code tags around your code.

Please take a moment to add the tags. Posting code between tags makes your code much easier to read and copy for testing, and it also maintains VBA formatting.

Please see Forum Rule #2 about code tags and adjust accordingly. Click on Edit to open your post, then highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here

(Note: this change is not optional. No help to be offered until this moderation request has been fulfilled.)