VBA Newbee Issues

BerkBoss

New Member
Joined
May 17, 2018
Messages
6
Hello everyone,

I am completely new to VBA, but the process I now need to perform is forcing me into learning about it.
Currently I'm working on a summary workbook that needs to pull data from multiple different workbooks. All of the workbooks I need to pull from are formatted the exact same, and I have figured out how to copy the data I need. The problem is I need the file names too, but the closest I've gotten is either the filename of the summary workbook, or just false.

This is what I have so far:
Sub Import_Candidate()
Dim vFile As Variant
Dim wbCopyTo As Workbook
Dim wsCopyTo As Worksheet
Dim wbCopyFrom As Workbook
Dim wsCopyFrom As Worksheet
Dim FullFileName As String

Set wbCopyTo = ActiveWorkbook
Set wsCopyTo = ActiveSheet
'-------------------------------------------------------------
'Open file with data to be copied

vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & _
"*.xl*", 1, "Select Excel File", "Open", False)

'If Cancel then Exit
If TypeName(vFile) = "Boolean" Then
Exit Sub
Else
Set wbCopyFrom = Workbooks.Open(vFile)
Set wsCopyFrom = wbCopyFrom.Worksheets(5)
End If

'--------------------------------------------------------------
'Copy Range
wsCopyFrom.Range("B6:D6").Copy
wsCopyTo.Range("F7:H7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

wsCopyFrom.Range("B12:D12").Copy
wsCopyTo.Range("I7:K7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

wsCopyFrom.Range("B20:D20").Copy
wsCopyTo.Range("L7:N7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

wsCopyFrom.Range("B28:D28").Copy
wsCopyTo.Range("O7:Q7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsCopyFrom.Range("B37:D37").Copy
wsCopyTo.Range("R7:T7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

wsCopyFrom.Range("B46:D46").Copy
wsCopyTo.Range("U7:W7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'Pull Data Workbook File Name
FileName = ThisWorkbook.FullName

Range("X7").Value = FileName

'Close file that was opened
wbCopyFrom.Close SaveChanges:=False

'---------------------------------------------------------------


End Sub

Thanks for all your help!
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Welcome to the Forum!

It appears your code is in the summary workbook (wbCopyTo) which is also Thisworkbook (the workbook the code is stored in). To get the name of the workbook you are copying from, you can use either vFile or wbCopyFrom.Name. If you want the full path (file path and file name) of the workbook you are copying from it would be wbCopyFrom.FullName.

So, try any of the following to see what you get:

Range("X7").Value = vFile
Range("X7").Value = wbCopyFrom.Name
Range("X7").Value = wbCopyFrom.FullName
 
Upvote 0
JoeMo, Thanks for the help! The naming convention for the different workbooks was one of the things throwing me off. Unfortunately, when I changed my script to Range("X7").Value = vFile or Range("X7").Value = wbCopyFrom.Name It's leaving X7 blank. I also tried both with .FullName but I didn't get anything back then either.
 
Upvote 0
Which workbook does the X7 cell belong to? You may have to qualify the range with a worksheet reference. The way you are currently using it, that's X7 in whatever workbook is the active workbook when that line executes.
 
Upvote 0
X7 is the summary workbook. I removed my "close without saving line" and checked the other workbook. It is putting the file name in the workbook I am opening. Thanks! that should fix the issue!
 
Upvote 0
Ok, I'm not sure if I should start a new thread or not since this a new hiccup I've ran into for the same macro. I currently have my macro running to copy data like I stated above, and now I'm trying to get it to create a word document and save it in the same folder as the data source for note taking during meetings.

Dim Path As String
Dim filename As String
Path = Sheets(2).Range("Y" & Rows.Count).End(xlUp).Offset(0)
filename = Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(0)
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Add
With wrdDoc
.SaveAs2 filename:=Path & "/" & filename & ".doc", FileFormat:=wdFormatXMLDocument
.Close ' close the document
End With
wrdApp.Quit ' close the Word application
Set wrdDoc = Nothing
Set wrdApp = Nothing

It creates the word document in the right folder, but because the A column is fully filled out before I start importing my data, it's naming the file after the title cell for that column instead of the entry for the current row I'm working with. How do I make the filename look at A from the last row I entered? Thanks in advance.
 
Upvote 0
I accidently only copied a portion of my script the first time.

Sub Import_Candidate()
Dim vFile As Variant
Dim wbCopyTo As Workbook
Dim wsCopyTo As Worksheet
Dim wbCopyFrom As Workbook
Dim wsCopyFrom As Worksheet
Dim FullFileName As String
Dim i As Integer
Dim Path As String
Dim filename As String
Set wbCopyTo = ActiveWorkbook
Set wsCopyTo = Worksheets(2)
'-------------------------------------------------------------
'Open file with data to be copied

vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & _
"*.xl*", 1, "Select Excel File", "Open", False)

'If Cancel then Exit
If TypeName(vFile) = "Boolean" Then
Exit Sub
Else
Set wbCopyFrom = Workbooks.Open(vFile)
Set wsCopyFrom = wbCopyFrom.Worksheets(5)
End If

'--------------------------------------------------------------
'Copy Range
wsCopyFrom.Range("B6:D6").Copy
wsCopyTo.Range("F" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

wsCopyFrom.Range("B12:D12").Copy
wsCopyTo.Range("I" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

wsCopyFrom.Range("B20:D20").Copy
wsCopyTo.Range("L" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

wsCopyFrom.Range("B28:D28").Copy
wsCopyTo.Range("O" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsCopyFrom.Range("B37:D37").Copy
wsCopyTo.Range("R" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

wsCopyFrom.Range("B46:D46").Copy
wsCopyTo.Range("U" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'Pull Data Workbook File Name
filename = wbCopyFrom.Name
FilePath = wbCopyFrom.Path

ThisWorkbook.Activate
Sheets(2).Select
Range("X" & Rows.Count).End(xlUp).Offset(1).Value = filename
'Copy Filepath to hidden cell for later reference
Range("Y" & Rows.Count).End(xlUp).Offset(1).Value = FilePath

'Close file that was opened
wbCopyFrom.Close SaveChanges:=False
Sheets(1).Select

'--------------------------------------------------------------
'Create word file for comments
Path = Sheets(2).Range("Y" & Rows.Count).End(xlUp).Offset(0)
filename = Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(0)
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Add
With wrdDoc
.SaveAs2 filename:=Path & "/" & filename & ".doc", FileFormat:=wdFormatXMLDocument
.Close ' close the document
End With
wrdApp.Quit ' close the Word application
Set wrdDoc = Nothing
Set wrdApp = Nothing

End Sub
 
Upvote 0
Well,

I managed to blunder my way through the issue until I fixed it.
I changed the filename line to this:

filename = Sheets(2).Range("F" & Rows.Count).End(xlUp).Offset(0, -5)
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,177
Members
453,021
Latest member
Justyna 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
Back
Top