I'm very new to vba. I found the below recent thread and vba but am not able to amend the vba accordingly.
www.mrexcel.com
I have 700 files which are all named ABC 00123456.
Within each file are three tabs, the 2nd tab, "Pikachu", contains a 6 digit value in cell Q2.
I just want to extract the filename and it's corresponding value from "Pikachu" and cell Q2. Output can be any form.
Any help would be greatly appreciated.
![www.mrexcel.com](https://www.mrexcel.com/board/styles/mrexcel/mrexcel-logo-og.png)
VBA to copy data from multiple workbooks into master sheet
I had an extra space in one of the lines. Try: Sub CopyRange() Application.ScreenUpdating = False Dim wkbDest As Workbook Dim wkbSource As Workbook Set wkbDest = ThisWorkbook Dim LastRow As Long Const strPath As String = "C:\Users\xbv\Desktop\group1\" ChDir strPath...
I have 700 files which are all named ABC 00123456.
Within each file are three tabs, the 2nd tab, "Pikachu", contains a 6 digit value in cell Q2.
I just want to extract the filename and it's corresponding value from "Pikachu" and cell Q2. Output can be any form.
Any help would be greatly appreciated.
VBA Code:
Sub CopyRange()
Application.ScreenUpdating = False
Dim wkbsource As Workbook, wsDest As Worksheet, LastRow As Long
Set wsDest = ThisWorkbook.Sheets("Master")
Const strPath As String = "C:\Users\xbv\Desktop\group1\"
ChDir strPath
strExtension = Dir("*.xlsm")
Do While strExtension <> ""
Set wkbsource = Workbooks.Open(strPath & strExtension)
If Not IsError(Evaluate("=ISREF('[" & wkbsource.Name & "]" & "Data" & "'!$A$1)")) Then
With wkbsource.Sheets("Data")
LastRow = .Range("D" & Rows.Count).End(xlUp).Row
.Range("D3:I" & LastRow).Copy
With wsDest
.Cells(.Rows.Count, "D").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
.Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(LastRow - 2) = wkbsource.Name
If Not IsError(Evaluate("=ISREF('[" & wkbsource.Name & "]" & "Info" & "'!$A$1)")) Then
.Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0).Resize(LastRow - 2).Value = wkbsource.Sheets("Info").Range("B2").Value
.Cells(.Rows.Count, "C").End(xlUp).Offset(1, 0).Resize(LastRow - 2).Value = wkbsource.Sheets("Info").Range("B3").Value
End If
End With
End With
ElseIf Not IsError(Evaluate("=ISREF('[" & wkbsource.Name & "]" & "Info" & "'!$A$1)")) Then
With wsDest
.Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(LastRow - 2) = wkbsource.Name
.Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0).Resize(LastRow - 2).Value = wkbsource.Sheets("Info").Range("B2").Value
.Cells(.Rows.Count, "C").End(xlUp).Offset(1, 0).Resize(LastRow - 2).Value = wkbsource.Sheets("Info").Range("B3").Value
End With
End If
wkbsource.Close savechanges:=False
strExtension = Dir
Loop
Application.ScreenUpdating = True
End Sub