HiHi, disclaimer: I have no experience with coding I have a code which takes values from cells (B2:C2) from multiple worksheets in a folder on my desktop and pasts it into the master workbook. This works great, however, I don't want the copied cells pasted consecutively down cells (F3:G3)- they need to be pasted into specific cells. This sounds complicated, and I'm sure it is. First, here's my base code which I have modified (from this code) to fit my needs:
Sub MergeAllWorkbooks()
Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim FileName As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
' Set summarysheet to activeworkbook/activesheet where the macro runs
Set SummarySheet = ActiveWorkbook.ActiveSheet
' Modify this folder path to point to the files you want to use.
FolderPath = "C:\Users\Me\Desktop\Extracted Data\16.12.2021\"
' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*.csv*")
' Loop until Dir returns an empty string.
Do While FileName <> ""
' Open a workbook in the folder
Set WorkBk = Workbooks.Open(FolderPath & FileName)
'loop through all Sheets in WorkBk
For Each sh In WorkBk.Worksheets
' Set the source range to be A9 through C9.
Set SourceRange = Sheets(sh.Name).Range("B2:C2")
' Set the destination range to start at column B and
' be the same size as the source range.
Set DestRange = SummarySheet.Range("F" & SummarySheet.Range("F" & Rows.Count).End(xlUp).Row 1)
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
SourceRange.Columns.Count)
' Copy over the values from the source to the destination.
DestRange.Value = SourceRange.Value
Next sh
' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False
' Use Dir to get the next file name.
FileName = Dir()
Loop
' Call AutoFit on the destination sheet so that all
' data is readable.
ActiveSheet.Columns.AutoFit
'Message Box when tasks are completed
MsgBox "Task Complete!"
End Sub
So, this runs and does copy the values from each workbook within the source folder to the master. I want to make it so that: If it copies from a work book that contains i.e "282579" and "Ch.4" to the cells that correspond to those values. To clarify, I have added a Screenshot of my master workbook. If it copies a value from a source workbook with a title that contains 282579 and Ch.4, it will paste those 2 values into 282579's Ch.4 cell located at (F10:G10) and so on. Tried using the If function (like, If (workbook has this in its name) but I have no idea how to specify which cells it needs to be pasted in)
I hope I have made sense and that this is understandable.
edit: if a copy of the data I use is needed, I can supply it
CodePudding user response：
From your explanation it is not clear if you are able to match the source worksheets with a specific Ch. If you can, I'd advise to define a Ch variable soon after the For each sh loop, then you need to initiate another loop in the master workbook on column D for each row until you get the row number of the Ch variable. You use the row number to define the destination range
Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim FileName As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range
Dim n As Long 'Ch substring position
Dim Ch As String 'Ch variable for source file
Dim LastChRow As Long 'lastrow of Ch in summary sheet
Dim ChSummary As String 'Define the Ch string in summary sheet
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
' Set summarysheet to activeworkbook/activesheet where the macro runs
Set SummarySheet = ActiveWorkbook.ActiveSheet
' Define LastChRow
LastChRow = SummarySheet.Cells(Rows.Count, "D").End(xlUp).Row
' Modify this folder path to point to the files you want to use.
FolderPath = "C:\Users\Me\Desktop\Extracted
Data\16.12.2021\"
' Call Dir the first time, pointing it to all Excel files in the
folder path.
FileName = Dir(FolderPath & "*.csv*")
' Loop until Dir returns an empty string.
Do While FileName <> ""
'define starting charachter of Ch source file for string manipulation
n = InStr(FileName, "Ch")
'define Ch variable
Ch = Trim(Mid(FileName, n, 5))
' Open a workbook in the folder
Set WorkBk = Workbooks.Open(FolderPath & FileName)
'loop through all Sheets in WorkBk
For Each sh In WorkBk.Worksheets
For i = 3 To LastChRow
'Define ChSummary variable in loop
ChSummary = "Ch" & " " & SummarySheet.Range("D" & i)
If ChSummary = Ch Then
' Set the source range to be A9 through C9.
Set SourceRange = Sheets(sh.Name).Range("B2:C2")
' Set the destination range to start at column B and
' be the same size as the source range.
Set DestRange = SummarySheet.Range("F" & i & ":G" & i)
'Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
' SourceRange.Columns.Count)
' Copy over the values from the source to the destination.
DestRange.Value = SourceRange.Value
End If
Next i
Next sh
' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False
' Use Dir to get the next file name.
FileName = Dir()'
CodePudding user response：
Use a Regular Expression to extract the SN and Ch. numbers from the filename. Use Find to located the SN on the summary sheet then scan the merged rows for the Ch number.
Sub MergeAllWorkbooks()
' Modify this folder path to point to the files you want to use.
Const FolderPath = "C:\Users\Me\Desktop\Extracted Data\16.12.2021\"
Dim wb As Workbook, wbCSV As Workbook
Dim ws As Worksheet, wsCSV As Worksheet
Dim rngCSV As Range, fnd As Range, bFound As Boolean
Dim Filename As String, n As Long, i As Long
' Set summarysheet to activeworkbook/activesheet where the macro runs
Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet
' regular expression to extract numbers
' example VS SAAV_282579 ch 4 Data.csv
Dim Regex As Object, m As Object, SN As Long, CH As Long
Set Regex = CreateObject("vbscript.regexp")
With Regex
.IgnoreCase = True
.Pattern = "(_(\d ) ch (\d ) Data)"
End With
' Call Dir the first time, pointing it to all Excel files in the folder path.
Filename = Dir(FolderPath & "*Data.csv*")
' Loop until Dir returns an empty string.
Application.ScreenUpdating = False
Do While Filename <> ""
' extract SN and Ch from filename
If Regex.test(Filename) Then
Set m = Regex.Execute(Filename)(0).submatches
SN = m(1)
CH = m(2)
Debug.Print Filename, SN, CH
' Find SN
Set fnd = ws.Range("B:B").Find(SN, LookIn:=xlValues, lookat:=xlWhole)
If fnd Is Nothing Then
MsgBox SN & " not found !", vbCritical, Filename
Else
' find ch.
bFound = False
For i = 0 To fnd.MergeArea.Count - 1
If ws.Cells(fnd.Row i, "D") = CH Then ' Col D
bFound = True
' Open a workbook in the folder
Set wbCSV = Workbooks.Open(FolderPath & Filename, ReadOnly:=True)
ws.Cells(fnd.Row i, "F").Resize(, 2).Value2 = wbCSV.Sheets(1).Range("B2:C2").Value2
' Close the source workbook without saving changes.
wbCSV.Close savechanges:=False
Exit For
End If
Next
If bFound = False Then
MsgBox "Ch." & CH & " not found for " & SN, vbExclamation, Filename
End If
End If
n = n 1
Else
Debug.Print Filename & " skipped"
End If
' Use Dir to get the next file name.
Filename = Dir()
Loop
' Call AutoFit on the destination sheet so that all
' data is readable.
ws.Columns.AutoFit
Application.ScreenUpdating = True
'Message Box when tasks are completed
MsgBox n & " csv files found.", vbInformation, "Task Complete!"
End Sub