CODEWITHSUNDEEP
vbaexcel
RalphDylan
RalphDylan

Reputation: 21

Copying cells from multiple workbooks to a single worksheet

I want to extract say column A1:A5 from multiple workbooks and copy it to a single worksheet. Copying each workbook into the adjacent column.

For example:

Workbook one (A1:A5) will copy to Master workbook (A1:A5) Workbook two (A1:A5) will copy to Master workbook (B1:B:5)

I have this code which sums all the values.

Sub SUM_Workbooks()
Dim FileNameXls, f
Dim wb As Workbook, i As Integer
FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xls*", MultiSelect:=True)

If Not IsArray(FileNameXls) Then Exit Sub

Application.ScreenUpdating = False

For Each f In FileNameXls
Set wb = Workbooks.Open(f)
Dim rngPaste As Range
With ThisWorkbook.Sheets(1)
     Set rngPaste = .Range("A" & .Columns.Count).End(xlToLeft).Offset(, 1)
End With
rngPaste.Value = wb.Name
wb.Worksheets("Page 3").Range("P18:P22").Copy
rngPaste.Offset(1).PasteSpecial Paste:=xlPasteValues
wb.Close SaveChanges:=False
Next f

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

What I need is to paste the value from the workbooks into adjacent columns.

Upvotes: 0

Views: 187

Answers (2)

Scott Holtzman
Scott Holtzman

Reputation: 27249

Change this line:

ThisWorkbook.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks:=True, Transpose:=False

To this bit of code:

For Each f In FileNameXls
    Set wb = Workbooks.Open(f)
    Dim rngPaste as Range
    With ThisWorkbook.Sheets(1)
         Set rngPaste = .Range("A" & .columns.Count).End(xlToLeft).Offset(,1)
    End With
    rngPaste.Value = wb.Name
    wb.Worksheets("Page 3").Range("P18:P22").Copy
    rngPaste.Offset(1).PasteSpecial Paste:=xlPasteValues
    wb.Close SaveChanges:=False
Next f

What this will do is go to the last column each time and then move all the way to left to find the last column with actual data, then offset that by 1 column. In row 1 of that column, the name of the workbook will be entered. The data will be entered starting in row 2.

Upvotes: 1

Vikas Jain
Vikas Jain

Reputation: 1

With ThisWorkbook.Sheets(1)
.Range("A" & .Columns.Count).End(xlToLeft), Operation:=xlAdd, SkipBlanks:=True
End With

You need to put this between "For" loop in order to extract data from all the excel sheets/workbooks.

Upvotes: 0

Related Questions