VBA Code 2 import many cells not in range from many workbooks
Solved/Closed
samirelsabagh
Posts
4
Registration date
Wednesday April 17, 2013
Status
Member
Last seen
April 21, 2013
-
Apr 17, 2013 at 10:11 PM
samirelsabagh Posts 4 Registration date Wednesday April 17, 2013 Status Member Last seen April 21, 2013 - Apr 21, 2013 at 09:05 PM
samirelsabagh Posts 4 Registration date Wednesday April 17, 2013 Status Member Last seen April 21, 2013 - Apr 21, 2013 at 09:05 PM
Related:
- VBA Code 2 import many cells not in range from many workbooks
- Tentacle locker 2 - Download - Adult games
- Five nights in anime 2 - Download - Adult games
- Battery reset code - Guide
- Euro truck simulator 2 download free full version pc - Download - Simulation
- Feeding frenzy 2 download - Download - Arcade
2 responses
rizvisa1
Posts
4478
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
766
Apr 18, 2013 at 05:13 AM
Apr 18, 2013 at 05:13 AM
So content from each workbook becomes, a row in this new workbook ?
rizvisa1
Posts
4478
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
766
Apr 21, 2013 at 08:49 PM
Apr 21, 2013 at 08:49 PM
Do this
1. Create a new workbook
2. Add a sheet called "Setup" in it. This will have three columns at row 1. The content of the three columns are
i. New Sheet Header (column A)
ii. Sheet to copy from (column B)
iii. Cell to copy from (column C)
a. Row 1: column description. you can leave them blank if you want
b. From row 2 on
i. in column A, what should be the column header on the new workbook (example Country)
ii. in column B, from what sheet the data is to be copied from (example Sheet2)
iii. in column C, from what cell of the sheet the data is to be copied from (H6)
3. Insert the macro in a new module and change the bold line (workbookLocation = "C:\Users\haadi\Documents\test") in the code
1. Create a new workbook
2. Add a sheet called "Setup" in it. This will have three columns at row 1. The content of the three columns are
i. New Sheet Header (column A)
ii. Sheet to copy from (column B)
iii. Cell to copy from (column C)
a. Row 1: column description. you can leave them blank if you want
b. From row 2 on
i. in column A, what should be the column header on the new workbook (example Country)
ii. in column B, from what sheet the data is to be copied from (example Sheet2)
iii. in column C, from what cell of the sheet the data is to be copied from (H6)
3. Insert the macro in a new module and change the bold line (workbookLocation = "C:\Users\haadi\Documents\test") in the code
Option Explicit ' user definded data type to hold sheet and cell information Type lookupInformation sheet As String ' sheet name cell As String ' cell example D4 header As String 'header to be posted on new workbook End Type 'main sub routine ' Public Sub copySpecificCellsFromWorkbooks() Dim workbookLocation As String ' where workbooks are Dim setupSheet As String ' set up sheet. contains information about sheet name ' and cell on that sheet that needs to be copied. Dim processWorkbookName As String 'workbook to process Dim lookupInformations() As lookupInformation ' sheet name and cell information from where data needs to be copied Dim newWorkbook As Workbook ' new workbook Dim finalRow As Long ' number of rows used on the final sheet setupSheet = "Setup" workbookLocation = "C:\Users\haadi\Documents\test" lookupInformations = obtainSetup(setupSheet) processWorkbookName = Dir(workbookLocation & "\*.xls*") If (processWorkbookName <> vbNullString) Then Set newWorkbook = Workbooks.Add Call writeheader(newWorkbook, lookupInformations) finalRow = 1 Do While (processWorkbookName <> vbNullString) finalRow = finalRow + 1 Call processWorkbook(workbookLocation & "\" & processWorkbookName, lookupInformations, newWorkbook, finalRow) processWorkbookName = Dir() Loop End If End Sub Private Sub writeheader(newWorkbook As Workbook, lookupInformations() As lookupInformation) Dim counter As Long With newWorkbook.Sheets("Sheet1") For counter = LBound(lookupInformations) To UBound(lookupInformations) .Cells(1, counter) = lookupInformations(counter).header Next counter End With End Sub Private Function obtainSetup(setupSheet As String) As lookupInformation() Dim lookupInformations() As lookupInformation Dim setupRow As Integer With Sheets(setupSheet) setupRow = .Cells(.Rows.Count, "B").End(xlUp).Row ReDim lookupInformations(0 To setupRow - 1) Do While (setupRow > 1) lookupInformations(setupRow - 2).header = .Cells(setupRow, "A") lookupInformations(setupRow - 2).sheet = .Cells(setupRow, "B") lookupInformations(setupRow - 2).cell = .Cells(setupRow, "C") setupRow = setupRow - 1 Loop End With obtainSetup = lookupInformations End Function Private Sub processWorkbook(workbookFullName As String, lookupInformations() As lookupInformation, newWorkbook As Workbook, finalRow As Long) Dim readWorkbook As Workbook Dim counter As Integer Dim sheet As String Dim cell As String Set readWorkbook = Workbooks.Open(workbookFullName) With newWorkbook.Sheets("Sheet1") For counter = LBound(lookupInformations) To UBound(lookupInformations) sheet = lookupInformations(counter).sheet cell = lookupInformations(counter).cell .Cells(finalRow, counter + 1) = readWorkbook.Sheets(sheet).Range(cell) Next counter readWorkbook.Close SaveChanges:=False Set readWorkbook = Nothing End With End Sub .
samirelsabagh
Posts
4
Registration date
Wednesday April 17, 2013
Status
Member
Last seen
April 21, 2013
Apr 21, 2013 at 09:05 PM
Apr 21, 2013 at 09:05 PM
Thanks heaps .. I found a good Merge add-in which solved my problem. Here is the link for it
https://www.rondebruin.nl/win/addins/rdbmerge.htm
https://www.rondebruin.nl/win/addins/rdbmerge.htm
Apr 18, 2013 at 06:43 AM