Extracting & copying both cell data and file name from one workbook to another with VBA

k10riley

New Member
Joined
Dec 1, 2021
Messages
24
Office Version
  1. 365
Platform
  1. Windows
Hello!

I have create some code that consolidates a series of individual sheets into one sheet in another workbook. Currently the code copies three columns and adds this data to the sheet. My question is, how can I instead copy two columns and add the file name into the third column of the consolidated sheet. Code listed below, skip down the red comment.

Sub CopyRangeind()
Application.ScreenUpdating = False
Dim wkbDest As Workbook
Dim wkbSource As Workbook
Set wkbDest = ThisWorkbook
Dim LastRow As Long
'location of workbooks you wish to consolidate information from
Const strPath As String = "C:\2020 Survey\"
ChDir strPath

'location of where the copied data will be pasted
wkbDest.Sheets("2020 Individual Responses").Range("B12:D" & rows.count - 1000).ClearContents
strExtension = Dir("*.xls*")
Do While strExtension <> ""
Set wkbSource = Workbooks.Open(strPath & strExtension)
With wkbSource
'change .sheets("insert sheet name of sheet to be copied per workbook").cells.find
LastRow = .Sheets("Model Identification").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'remove duplicates, ignore blank sheets, and keeps header
'if statement determines the last row of your header -> LastRow > insert row number for bottom of header

****** Specifically here, currently this code is copying the columnsL C, D, and G. Instead of G I would like to copy the file name instead and place this into the new consolidated sheet (column D).************

If LastRow > 11 Then
.Sheets("Model Identification").Range("C9:D" & LastRow & ",G12:G" & LastRow).Copy wkbDest.Sheets("2020 Individual Responses").Cells(rows.count, "B").End(xlUp).Offset(1, 0)
End If
'closes workbooks that data is copied from
.Close savechanges:=False
End With


'sortcolumnB Macro, change the .worksheets("insert sheet you are sorting")
'adjust the Key:=Range("insert cell you are sorting on") and Order:=insert ascending, descending, etc.
ActiveWorkbook.Worksheets("2020 Individual Responses").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("2020 Individual Responses").Sort.SortFields.Add _
Key:=Range("B11"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("2020 Individual Responses").Sort
.SetRange Range("B12:D405")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
strExtension = Dir
Loop
Application.ScreenUpdating = True
End Sub


Thanks!
 

NdNoviceHlp

Well-known Member
Joined
Nov 9, 2002
Messages
3,017
Change that line to...
Code:
With wkbDest.Sheets("2020 Individual Responses")
Firstrow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
End With
Not real sure of the math. Please keep back up copy of your wb before using the code. Dave
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,163,603
Messages
5,832,670
Members
430,153
Latest member
Javid_P

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
Top