VBA Macro help please!

[Eddier32]

Hello Everyone,

I am new to the Macro world and need some help from the professionals.

I need to create a macro that creates:

• from the folder list of excel files, I need them to be save in the same workbook as the combined worksheet but in different tabs
• Finally from the saved files in the new tabs I would only need the information that has only been filled from column (AH) and the corresponding rows (A - AK) information and nothing else from that sheet
• For the end results I should have, 1 combined worksheet with all the files including only column (AH) with corresponding rows (A-Ak) information as well.

FYI each excel file has large data.

Below is a code I was working with but I am most likely doing it wrong.

Sub MergeWorkbooks()

Dim FolderPath As String
Dim File As String

FolderPath = "H:\Benefits_Quality_Assurance\2021\Testing Team\Testing Projects\Reference Documents\Training Materials\Training Assignments_Eduardo Rodriguez\Automation Testing\Results\Professional\Professional Consolidate worksheets macro\"

File = Dir(FolderPath)

Do While File <> ""

Workbooks.Open FolderPath & File
ActiveWorkbook.Worksheets(1).Copy _
after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
Workbooks(File).Close

File = Dir()

Loop

Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Combined"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub

Please feel free to improve on it or create a whole new code. I would definitely love to learn how you came about this.

 

[Eddier32]

Update on the code Below.

Sub MergeWorkbooks()

Dim FolderPath As String
Dim File As String
Dim wbkNew As Workbook
Dim wbkOpen As Workbook

FolderPath = "H:\Benefits_Quality_Assurance\2021\Testing Team\Testing Projects\Reference Documents\Training Materials\Training Assignments_Eduardo Rodriguez\Automation Testing\Results\Professional\Professional Consolidate worksheets macro\"
File = Dir(FolderPath & "*.xlsx")

Do While File <> ""

Set wbkOpen = Workbooks.Open(FolderPath & File)
If wbkNew Is Nothing Then
wbkOpen.Worksheets(1).Copy
Set wbkNew = ActiveWorkbook
Else
wbkOpen.Worksheets(1).Copy after:=wbkNew.Worksheets(wbkNew.Worksheets.Count)
End If
wbkNew.ActiveSheet.Name = Replace(File, ".xlsx", "")
wbkOpen.Close
File = Dir()
Loop

Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Combined"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next

MsgBox "All workbooks have been added! Please rename all tables."

End Sub

Still needing those certain number of columns and rows. need a code for that and should be good