Macro to copy data from multiple worksheets into 1 worksheet

[Amstrad]

I have a spreadsheet that has hundreds of different worksheets. Within each worksheet there is a single row of data from cell A2 to J2.

I want to copy this row from each worksheet into a single worksheet. I also want it to copy the name of the worksheet into column A and then paste the data next to it. That way, I will be able to see which worksheet the data is for.

Any help on how I can build a macro to loop through each worksheet and do this would be greatly appreciated.

Thanks for your help.

 

[cmeredith73]

Hi this Macro works awesome - but how do you get it to pick a different row. The row, I'm trying to copy over, is found in A36:D36. When I update the copy, it doesnt do the Sheet name copy.

What if you want it to grab a 2nd section of the same tab? ie Row A36:D36 and Row A37:D37

This should work for you.

Just add a sheet in to your workbook called Master. Make sure you save the file first or the sheet names will not pull through

Sub CombineData()
Dim Sht As Worksheet
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "Master" Then
Sht.Select
Range("A:A").Insert
Range("A2").Formula = "=Mid(Cell(""filename"",B1),Find(""]"",Cell(""filename""))+1,255)"
Range("A2").Copy
Range("A2").PasteSpecial Paste:=xlPasteValues
Range("A2:K2").Copy
Sheets("Master").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Sht.Select
Range("A:A").Delete
Else
End If
Next Sht
 
 
End Sub

 

[ocp_zoe]

Did anyone find a solution for combining worksheets from various workbooks into one master work book?
I have this working with sheets in the same workbook but would like to have a stand-alone workbook that pulls from other XL files.

Below is the code I am using now. Note that I changed M to G as that is my last column and start with A3 as my sheets have headers.

Sub CombineData()
Dim Sht As Worksheet
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "Master" And Sht.Range("A3").Value <> "" Then
Sht.Select
LastRow = Range("A65536").End(xlUp).Row
Range("A3", Cells(LastRow, "G")).Copy
Sheets("Master").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Sht.Select
Range("A3", Cells(LastRow, "G")).ClearContents
Else
End If
Next Sht




End Sub

 

[ocp_zoe]

Update: This is what I am using to combine sheets from different workbooks into another workbook.
Note that the new workbook needs to be saved in a different folder than your source workbooks.

Sub simpleXlsMerger()
Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")

'change folder path of excel files here
Set dirObj = mergeObj.Getfolder("P:\FILE PATH\FOLDER\SUBFOLDER")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)

' "A3" is my starting cell on every worksheet
'for example use "A3:G" to merge all files start from columns A and rows 3 to Column G (my last column)
Range("A3:G" & Range("A" & Rows.Count).End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate

'Do not change the following column. It's not the same column as above
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False
bookList.Close
Next
End Sub

 

[ocp_zoe]

If anyone has tips, my goals for next round of edits are:
--deleting data off the source work sheets once it is copied onto master
--skipping the "save changes" prompt to the source work sheets

 

[Xtamata]

I have a spreadsheet that has hundreds of different worksheets. Within each worksheet there is a single row of data from cell A2 to J2.

I want to copy this row from each worksheet into a single worksheet. I also want it to copy the name of the worksheet into column A and then paste the data next to it. That way, I will be able to see which worksheet the data is for.

Any help on how I can build a macro to loop through each worksheet and do this would be greatly appreciated.

Thanks for your help.[/QU

thanks for sharing. i have a similar problem and urgently needs help. i have 80 worksheets with with several named column. i want to copy and combine 4 columns in a master worksheet.

Any help on how to write a macro to loop through each worksheet. thanks

 

[Xtamata]

i have a similar problem and needs help. i have 80 different worksheet with similar column (the column have header). i want to copy and combine only 4 columns to a Master worksheet.

Any help on how to build a Macro to loop through the different worksheets and copy and combine the columns. Regards

 

[sunexcel]

Hi,

I want VBA code to copy data from multiple worksheet into one worksheet along with worksheet name in first column. Please help.

 

[PJACK]

This code worked well for my requirement. Only clear contents is clearing out a formula which i wish to retain. Please help.

This willwork, let me know if there's any problems. And if anyone wants to clean up my code a little, feel free.

Sub CombineData()
Dim Sht As Worksheet
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "Master" And Sht.Range("A2").Value <> "" Then
Sht.Select
LastRow = Range("A65536").End(xlUp).Row
Range("A2", Cells(LastRow, "M")).Copy
Sheets("Master").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Sht.Select
Range("A2", Cells(LastRow, "M")).ClearContents
Else
End If
Next Sht


End Sub

 

[My Aswer Is This]

PJACK

I see your new here:
If you really want to use Vba one thing you should do is try reading the script.
Assuming you can read English you should read the code and see if you see anything about clearing content.

You should notice the below line of code says ClearContents.
So try removing that line of code and see if things work for you.

Range("A2", Cells(LastRow, "M")).[COLOR=#b22222]ClearContents[/COLOR]

 

[PJACK]

Thank you for replying. and yes I'm new to VBA.

I did read the script before posting my query here. However I guess I wasn't clear enough. I want to clear the data but want to retain formula. If i remove clearcontents, the data, ofcourse, still remains in the sheet.