CODEWITHSUNDEEP
vbaexcel
Cwala
Cwala

Reputation: 29

Copy different ranges when looping through workbooks

With the following code i am able to browse for multiple excel file's at the same time and paste them on single sheet below each other so my problem is it copies everything including their headers but the thing is i only want it to copy the first file with headers and the rest it must copy only data not headers and paste it below each other because all their headers are the same.

example:eg1 NAME,SURNAME,AGE
Kgotso,Smith,20

eg2 NAME,SURNAME,AGE

brian,brown,32

Result : NAME,SURNAME,AGE

Kgotso,Smith,20

brian,brown,32

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 + 2, 1)
    wbk2.Close
    Next i

End Sub

Upvotes: 0

Views: 1307

Answers (2)

chris neilsen
chris neilsen

Reputation: 53126

Try this

If i = 1 then
     ' Do your copy as is
Else
    ' Offset past firt row
    wbk2.Sheets(1).UsedRange.Offset(1, 0).Copy ...
    ' This will copy one blank line too
    ' Too avoid this extra line use instead
    Set rng2 = wbk2.Sheets(1).UsedRange.Offset(1, 0)
    Set rng2 = rng2.Resize(rng2.Rows.Count - 1)
    rng2.Copy ...
End If

Upvotes: 1

Jook
Jook

Reputation: 4682

This would be my quick attempt to this:

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")

'handling first file seperately
MsgBox fileStr(1), , GetFileName(CStr(fileStr(1)))
Set wbk2 = Workbooks.Open(fileStr(1))
wbk2.Sheets(1).UsedRange.Copy ws1.Cells(ws1.Range("A" & Rows.Count).End(xlUp).Row + 2, 1)
wbk2.Close

For i = 2 To UBound(fileStr)
MsgBox fileStr(i), , GetFileName(CStr(fileStr(i)))
Set wbk2 = Workbooks.Open(fileStr(i))
'using offset to skip the header - not the best solution,  but a quick one
wbk2.Sheets(1).UsedRange.Offset(1,0).Copy ws1.Cells(ws1.Range("A" & Rows.Count).End(xlUp).Row + 2, 1)
wbk2.Close
Next i

End Sub

Upvotes: 1

Related Questions