Copy single row from multiple workbooks to one main sheet

[pyrte]

Hi guys,

I am looking for a macro that will allow me to copy a single row (D81 - E81) values and put it in a master sheet one after another.

Here is the tricky part.

1. I have a folder with all the excel files in it
2. Each file has multiple worksheets and the data I need is on "Technical Sheet"
3. A2 is a Merged Cell and has the Date in it.

I am look at the output. that has the date followed by the row I need copied as mentioned above.

It would be really great if you guys can help me out. Thanks in advance.

Regards,
Eddie

[mancubus]

@pyrte

be more specific.

what does "that has the date followed by the row" mean?

is it A3?
then copy A3's from all workbooks?
what is it?

upload your workbook where necessary...

[snb]

Don't ever use merged cells.

[pyrte]

@pyrte

be more specific.

what does "that has the date followed by the row" mean?

is it A3?
then copy A3's from all workbooks?
what is it?

upload your workbook where necessary...

A2 has the date that needs to be copied. And there is another specific range I mentioned that has all the values that need to be copied.

When the data is copied to the new workbook. I want them to be in the following format.

Date in A1 and the Range in B2 onwards
and every other row appended at the bottom as the copy from each new workbook happens.

Hope that helps.

[mancubus]

i repeat snb's recommendation on not using the merged cells (at least in the files that you have Control over and in the future files, projects).


from
Workbook Name: All excel files in a specific folder
Worksheet Name: Technical Sheet
Ranges: A2, D81:E81

to
Workbook Name: Workbook that contains the macro
Worksheet Name: Master Sheet
Ranges: starting at A1, starting at B2:C2 (so there must be a 1 row gap between date (A2) and the data (D81:E81) in the destination sheet.)

is this what you are after?

[mancubus]

Sub vbax_57410_merge_data_multi_wb_certain_cells()

Dim fPath As String
Dim fFiles, ArrA2, ArrDE81
Dim j As Long, calc As Long

With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
.AskToUpdateLinks = False
calc = .Calculation
.Calculation = xlCalculationManual
End With

fPath = "S:\DATA\CONSOLIDATION_FILES\" 'change to suit
fFiles = Split(CreateObject("WScript.Shell").Exec("cmd /c Dir """ & fPath & "*.xl??"" /b").StdOut.ReadAll, vbCrLf)

ReDim ArrA2(UBound(fFiles) - 1)
ReDim ArrDE81(UBound(fFiles) - 1, 1)

For j = 0 To UBound(fFiles) - 1
With GetObject(fPath & fFiles(j))
ArrA2(j) = .Worksheets("Technical Sheet").Range("A2").Value
ArrDE81(j, 0) = .Worksheets("Technical Sheet").Range("D81").Value
ArrDE81(j, 1) = .Worksheets("Technical Sheet").Range("E81").Value
.Close 0
End With
Next

With ThisWorkbook.Worksheets("Master Sheet")
.Range("A1").Resize(UBound(ArrA2) + 1).Value = Application.Transpose(ArrA2)
.Range("B2").Resize(UBound(ArrDE81, 1) + 1, UBound(ArrDE81, 2) + 1).Value = ArrDE81
End With

With Application
.EnableEvents = True
.AskToUpdateLinks = True
.Calculation = calc
End With

End Sub

[snb]

or ?

Sub M_snb()
c00 = "S:\DATA\CONSOLIDATION_FILES\" 'change to suit
sn = Split(CreateObject("WScript.Shell").Exec("cmd /c Dir """ & c00 & "*.xls*"" /b").StdOut.ReadAll, vbCrLf)

reDim sp(UBound(sn),3)

For j = 0 To UBound(sn) - 1
With GetObject(c00 & sn(j)).sheets("Technical Sheet")
sp(j,0) = .Range("A2").Value
sp(j,1) = .Range("D81").Value
sp(j,2) = .Range("E81").Value
.Parent.Close 0
End With
Next

ThisWorkbook.sheets("Master Sheet").Range("A1").Resize(UBound(sp),ubound(sp,2))= sp
End Sub

[pyrte]

I agree about the point of not using merged cells. The problem is that these are standard reports that someone has built. There is nothing much I can do. The best is that I take the data I need and put it into a new workbook as a consolidated file.

I will try the macro you both have provided and test out the results and come back here with feedback. Thanks so much for your help and support.

[jolivanes]

Re: "There is nothing much I can do"
If you want, you could adapt below code to cycle through all workbooks/worksheets and change the merged areas to CenterAcrossSelection.



For Each c In ActiveSheet.UsedRange
With c
If .MergeCells Then
With .MergeArea
.UnMerge
.HorizontalAlignment = xlCenterAcrossSelection
End With
End If
End With
Next c

[snb]

@Joli


sheet1.cells.unmerge

[jolivanes]

Goedeavond, aka Good Evening
Re "sheet1.cells.unmerge"
Belief it t not, for a change I was aware of that snb but how would you format the cells that are merged into CenterAcrossSelection?

[pyrte]

@mancubus and @snb your macros worked like a charm. Even though I had merged cells in the workbook it got all the info I needed. I made one small adjustment after analyzing the codes.


When I provided the range I made a mistake by saying D to E it was D to O


After that adjustment I was able to get all the information I needed from all the workbooks in the folder.


Thanks so much guys for your help and support. You are truely MASTERS at this. You both made my day and saved me so much time and effort of going through 100's of files each day.


You are making the lives of so many people easy and in some way making us happy.

[pyrte]

@jolivanes - the thing with the macro that is provided above is I dont have to unmerge at all. But your code does come handy in other situations when I take care of merged cells. Thanks for that code.