VBA: Copy rows from one workbook to specific rows in another

ParaSitius

New Member
Joined
Nov 11, 2013
Messages
11
Hello,

I need to update the following code that I haphazardly mashed together from several sources on the Internet to be a bit more flexible if rows from the 12M file are added or removed. I also require the code to be able to find the first empty row in the Report file as I have eight of these 12M files in total that need to be stacked going down the Report file.

Code:
Sub LocationData()


Dim x As Workbook
Dim y As Workbook


'## Open 12M Data (x) and Report (y) workbooks first:
Set y = Workbooks.Open("File location\Report.xlsm")
Set x = Workbooks.Open("File location\12M Data.xls")


'##12M data copied first
'un-merge all the cells in the file to allow filtering
    Range("a1:AA600").UnMerge
'Choses all rows that contain the word Denominator
    Range("A9").AutoFilter Field:=3, Criteria1:="Denominator"
'Copies only the visible cells
    Range("A10:A394").SpecialCells(xlCellTypeVisible).Copy
'Opens the Report before pasting
Set y = Workbooks.Open("File location\Report.xlsm")
'Pastes the values starting from cell D7
    Workbooks("Report.xlsm").Worksheets("Location").Range("D7").PasteSpecial Paste:=xlPasteValues


Set x = Workbooks.Open("File location\12M Data.xls")
    Range("A9").AutoFilter Field:=3, Criteria1:="Denominator"
    Range("B10:B394").SpecialCells(xlCellTypeVisible).Copy
Set y = Workbooks.Open("File location\\Report.xlsm")
    Workbooks("Report.xlsm").Worksheets("Location").Range("C7").PasteSpecial Paste:=xlPasteValues


Set x = Workbooks.Open("File location\12M Data.xls")
    Range("A9").AutoFilter Field:=3, Criteria1:="Denominator"
    Range("D10:D394").SpecialCells(xlCellTypeVisible).Copy
Set y = Workbooks.Open("File location\\Report.xlsm")
    Workbooks("Report.xlsm").Worksheets("Location").Range("F7").PasteSpecial Paste:=xlPasteValues


Set x = Workbooks.Open("File location\12M Data.xls")
    Range("A9").AutoFilter Field:=3, Criteria1:="Item 1"
    Range("D11:D395").SpecialCells(xlCellTypeVisible).Copy
Set y = Workbooks.Open("File location\\Report.xlsm")
    Workbooks("Report.xlsm").Worksheets("Location").Range("G7").PasteSpecial Paste:=xlPasteValues


Set x = Workbooks.Open("File location\12M Data.xls")
    Range("A9").AutoFilter Field:=3, Criteria1:="Item 2"
    Range("D13:D397").SpecialCells(xlCellTypeVisible).Copy
Set y = Workbooks.Open("File location\\Report.xlsm")
    Workbooks("Report.xlsm").Worksheets("Location").Range("I7").PasteSpecial Paste:=xlPasteValues


Set x = Workbooks.Open("File location\12M Data.xls")
    Range("A9").AutoFilter Field:=3, Criteria1:="Item 3"
    Range("D14:D398").SpecialCells(xlCellTypeVisible).Copy
Set y = Workbooks.Open("File location\\Report.xlsm")
    Workbooks("Report.xlsm").Worksheets("Location").Range("K7").PasteSpecial Paste:=xlPasteValues


'Close x - 12M workbook:
'x = EmptyClipboard()
Application.CutCopyMode = False
x.Close SaveChanges:=False

To put some of the code in context.

1. I found that the Unmerge command is required as Columns A & B contain merged cells that cover several rows for each location, the filter command only works if they are unmerged first.
2. AutoFilter - Filters column C, allows me to than copy the data I require in other columns
3. SpecialCells - I now need this to copy from the first filtered row of data below the AutoFilter (row 9) to the last row containing data, minus 1 row (due to last row containing the overall total which isn't required here).
4. I need the first set of data to paste into Row 7 downwards, but for the remaining seven 12M files, I need them to find the first empty row. Example - First 12M file pastes into Row 7 to 95, the second 12M file will need to paste into Row 96 and so on.

If number 4 has to be spread across several Subs is fine as I have assigned eight macros to do this already with the current setup.

I know my coding is a bit of a mess but I'm a novice at VBA who is self-teaching himself so any help would be greatly appreciated.
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
4. I need the first set of data to paste into Row 7 downwards, but for the remaining seven 12M files, I need them to find the first empty row. Example - First 12M file pastes into Row 7 to 95, the second 12M file will need to paste into Row 96 and so on.
You can find the first available row (after the last populated row) in any column like this (this example for column A):

To set it equal to a number, broken out in multiple steps for illustration purposes:
Code:
Dim lastRow as Long
Dim nextRow as Long
lastRow = Cells(Rows.Count,"A").End(xlUp).Row
nextRow = lastRow + 1

To select the first available cell in column A after the last populated cell in column A:
Code:
Cells(Rows.Count,"A").End(xlUp).Offset(1,0).Select
 
Upvote 0
Hi Joe4,

After much faffing about and wondering why your code wasn't working, I've just clocked on to the fact that the first cell I want to paste data into is actually the first cell in a Table. I didn't design the Report spreadsheet so didn't pick up on this little nugget of information sooner.

Anyhow, I've found that the Table has been labelled as 'Table_FANG_QMS_StatsAggregator_PracticeGroup9'.

What amendment to your coding is required for this? I've looked about on the forum but I can't quite figure out how to add it in.
 
Upvote 0
I don't work much with tables.
Is it a blank table?
Do you need to first insert blank rows into the table before pasting data into it (otherwise, wouldn't you be posting data after the end of the table, outside of it)?
 
Upvote 0
Where I need to paste the data will be blank, there are some columns containing formulae but they won't be touched.

The table has enough rows in it that there won't be a need to insert any, the first empty cell in the table is C7, Row 6 contains the headers.
 
Upvote 0
Upvote 0

Forum statistics

Threads
1,214,430
Messages
6,119,438
Members
448,897
Latest member
dukenia71

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