CODEWITHSUNDEEP
excelvba
Cwala
Cwala

Reputation: 29

How to insert a blank space

the following code browse for excel workbook and allow you to select multiple workbook and paste them all in one sheet,its all working fine but my problem is when it paste them it does not leave space in between to separate the file's.Can any one please help me.

Sub Button4_Click()
Dim fileStr As Variant
Dim wbk1 As Workbook, wbk2 As Workbook
Dim ws1 As Worksheet

fileStr = Application.GetOpenFilename(FileFilter:="microsoft excel files (*.xlsx), *.xlsx", Title:="Get File", MultiSelect:=True)
Set wbk1 = ActiveWorkbook
Set ws1 = wbk1.Sheets("Sheet3")

For i = 1 To UBound(fileStr)

MsgBox fileStr(i), , GetFileName(CStr(fileStr(i)))

Set wbk2 = Workbooks.Open(fileStr(i))
wbk2.Sheets(1).UsedRange.Copy ws1.Cells(ws1.Range("A" & Rows.Count).End(xlUp).Row, 1)

wbk2.Close

Next i

End Sub

Upvotes: 0

Views: 1776

Answers (1)

Scott Holtzman
Scott Holtzman

Reputation: 27249

If I interpret your question (and the response to the comment) correctly, to place space between the data copied from different workbooks, change this line in your code:

ws1.Cells(ws1.Range("A" & Rows.Count).End(xlUp).Row, 1)

to this:

ws1.Cells(ws1.Range("A" & Rows.Count).End(xlUp).Row + 2, 1)

With your original code, you were actually replacing the last line of data from one workbook with the first line of the other. Adding the +2 will start the paste operation 2 rows below the last data set copied in, which will give you 1 blank row between data sets. Obviously, adjust the +2 to obtain more space :)

Update

I've modified your code to only copy headers on the first file pull.

Sub Button4_Click()

Dim fileStr As Variant
Dim wbk1 As Workbook, wbk2 As Workbook
Dim ws1 As Worksheet

fileStr = Application.GetOpenFilename(FileFilter:="microsoft excel files (*.xlsx), *.xlsx", Title:="Get File", MultiSelect:=True)
Set wbk1 = ActiveWorkbook
Set ws1 = wbk1.Sheets("Sheet3")

For i = 1 To UBound(fileStr)

    MsgBox fileStr(i), , GetFileName(CStr(fileStr(i)))

    Set wbk2 = Workbooks.Open(fileStr(i))

    If i = 1 Then ' if it's the first file, copy the headers

        wbk2.Sheets(1).UsedRange.Copy

    Else 'otherwise only copy the data (assumes headers are always in row 1

        wbk2.Sheets(1).Intersect(wbk2.Sheets(1).UsedRange, wbk2.Sheets(1).UsedRange.Offset(1)).Copy

    End If

    ws1.Cells(ws1.Range("A" & Rows.Count).End(xlUp).Row + 2, 1).PasteSpecial xlPasteAll


    wbk2.Close

Next i

End Sub

Upvotes: 1

Related Questions