PDA

View Full Version : Code suggestions required.



Auxie
08-08-2017, 03:01 AM
Hi guys and gals,

I'm a basic VBA user!

Trying to build a macro that will pull information from multiple different workbooks into a "summary" workbook.

My problem is that each workbook is going to have different number of rows so I need a code that will copy all cells with data (columns ends at L) then paste into the next empty row in the summary workbook.
I know how to determine the next empty row, however I'm unsure of the best way to copy+paste the data

Any suggestions would be greatly appreciated

mana
08-08-2017, 03:12 AM
MsgBox Workbooks("summary.xlsx").Sheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1).Row

Sorry, I misread
>I know how to determine the next empty row,

mdmackillop
08-08-2017, 03:20 AM
A few queries
Is it all the workbooks in a specific folder or how will they be identified?
One sheet in each book? All with the same name?
What is the Summary sheet name or is it a new sheet. Are there headers?
Is there a specific column that can be checked for the last data?

Auxie
08-08-2017, 03:25 AM
A few queries
Is it all the workbooks in a specific folder or how will they be identified?
One sheet in each book? All with the same name?
What is the Summary sheet name or is it a new sheet. Are there headers?
Is there a specific column that can be checked for the last data?

They are in a number of different folders - i know how to open these.
The worksheet name will be "Summary" - and yes there will be headers on the spreadsheet.
The last column with data will be L on all the sheets i will be copying form.

mdmackillop
08-08-2017, 03:55 AM
Something like

Sub Test()
Dim NxtRow%
Dim wb As Workbook
Dim Tgt As Range
Do
Set wb = YourWorkbooks 'Loop through
With Worksheets("Summary")
NxtRow = .Cells.Find("*", after:=Cells(1, 1), searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1
Set Tgt = .Cells(NxtRow, 1)
End With
wb.Sheets(1).UsedRange.Copy Tgt
wb.Close False
Loop
End Sub

SamT
08-08-2017, 05:58 AM
If you don't want to copy all the headers in the workbooks modify mdmackillop's code

Add
Dim SummaryHasHeader As boolean
And change
wb.Sheets(1).UsedRange.Copy Tgt To

If SummaryHasHeader Then
wb.Sheets(1).UsedRange.Offset(1).Copy Tgt
Else
wb.Sheets(1).UsedRange.Copy Tgt
SummaryHasHeader = True
End IF