Excel query

crazy frog

New Member
Joined
Jul 21, 2011
Messages
1
Hi, wondering if somebody can lend a hand with my query, I've written some code that reads/copys and pastes data from multiple workbooks in a specified folder to a master workbook starting in cell A2, the code works but i'm having trouble if i delete the information and re-run the code as it pastes it further down the worksheet and not back in Cell A2! I believe it's something stupid on my part so appologise now. Also if i update and save the multiple workbooks and re-run the code i have to re-run the code a number of times before it picks up the amendments

Any help greatly apprecited - Code is as follows

Private Sub getdata()

Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim wkbLastRow As Double
Dim wkb As Workbook
Dim wks As Worksheet
Dim dblLastRow As Double
Dim wkb_Copy2 As Workbook
Dim wks_Copy2 As Worksheet

Count = 1
'mycount = FoundFiles

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next

Set wbCodeBook = ThisWorkbook

'Change path to suit
With Application.FileSearch
.NewSearch
.LookIn = "C:\Users\Dave\Documents\test"
.FileType = msoFileTypeExcelWorkbooks
.Filename = "master.xls"

'Workbooks in folder
If .Execute > 0 Then
'Loop through all
For lCount = 1 To .FoundFiles.Count
'Open Workbook x and Set a Workbook variable to it
Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)

'location of master document to paste data
Set wkb_Copy2 = Workbooks("1master.xls")
Set wks_Copy2 = wkb_Copy2.Worksheets("sheet1")

'grab the data to be copied
Selection.Copy
Cells(Rows.Count, 1).End(xlUp).Row

'find out the last used row in the worksheet where the data is being copied to
dblLastRow = wks_Copy2.Cells.SpecialCells(xlLastCell).Row

'copy to 1 row below where the data ends [assume column A]
wks_Copy2.Range("A2" & dblLastRow).PasteSpecial xlPasteAll

'empty memory
Set wks_Copy2 = Nothing
Set wkb_Copy2 = Nothing

'Select data range to copy
Range("A1:O25").Select
Selection.Copy

'Paste append to a spreadsheet it finds the last used row and copies to the next row)
wkbLastRow = wks.Cells.SpecialCells(xlLastCell).Row
wks.Range("A" & dblLastRow + 1).PasteSpecial xlPasteAll

'empty memory
Set wks = Nothing
Set wkb = Nothing

ActiveWorkbook.Save
ActiveWorkbook.Close


Next lCount
End If
End With

On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.

Forum statistics

Threads
1,224,583
Messages
6,179,673
Members
452,937
Latest member
Bhg1984

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top