Macro for copying data from multiple sheets to a common sheet based on a cell value

[jmk15315]

Good morning,

I have the following code that works, just not how I feel would be better. Hoping someone can help me tweak the code to improve function.

There are multiple sheets that selections are made to generate a cost for a project. In order to assist the employee in generating a list of the items selected, I need to copy the items from the multiple pages, and paste them into a new sheet in the same workbook. The selected items have multiple groups and the intent is to organize them by groups as well.

My problem is this.
1. Need columns "A:K" copied for cells that contain a value greater than 0 in column "B" with a group of "<Multiple Values>" in column "J"
2. My code is only copying Column "A"
3. It does find all values with the same group, however, I would need to create this same macro for 24 separate groups.
4. This copies the data into 24 sheets, which I then need to combine into a single sheet.
5. Each Group needs to be identified to avoid confusion as the data is communicated downstream.

Is there a way to combine these functions into a single macro without having it be 10000 lines of code?

Thanks in advance for any assistance.

Here is what I have thus far.......

Sub IMPORT_FG0100()

Dim wsPlatform As Worksheet
Dim wsRobot As Worksheet
Dim wsProcessGear As Worksheet
Dim wsControls As Worksheet
Dim wsMaterialFlow As Worksheet
Dim wsModular As Worksheet
Dim wsSpotWeld As Worksheet
Dim wsCustom As Worksheet
Dim wsFG0100 As Worksheet
Dim wsFG0200 As Worksheet
Dim wsFG0300 As Worksheet
Dim wsFG0400 As Worksheet
Dim wsFG0500 As Worksheet
Dim wsFG0600 As Worksheet
Dim wsFG0700 As Worksheet
Dim wsFG0800 As Worksheet
Dim wsFG0900 As Worksheet
Dim wsFG1000 As Worksheet
Dim wsFG1100 As Worksheet
Dim wsFG1200 As Worksheet
Dim wsFG1300 As Worksheet
Dim wsFG1400 As Worksheet
Dim wsFG1500 As Worksheet
Dim wsFG1600 As Worksheet
Dim wsFG1700 As Worksheet
Dim wsFG1800 As Worksheet
Dim wsFG1900 As Worksheet
Dim wsFG2000 As Worksheet
Dim wsFG2100 As Worksheet
Dim wsFG2200 As Worksheet
Dim wsFG2300 As Worksheet
Dim wsFG2400 As Worksheet
Dim lastRow As Long
Dim i As Long
Dim j As Long

' Set references to the worksheets
Set wsPlatform = ThisWorkbook.Worksheets("Platform")
Set wsRobot = ThisWorkbook.Worksheets("Robot")
Set wsProcessGear = ThisWorkbook.Worksheets("Process & Torch")
Set wsControls = ThisWorkbook.Worksheets("Controls")
Set wsMaterialFlow = ThisWorkbook.Worksheets("Mat. Flow")
Set wsModular = ThisWorkbook.Worksheets("Modular")
Set wsSpotWeld = ThisWorkbook.Worksheets("Spot_Weld")
Set wsCustom = ThisWorkbook.Worksheets("Custom")
Set wsPlatform = ThisWorkbook.Worksheets("Platform")
Set wsRobot = ThisWorkbook.Worksheets("Robot")
Set wsProcessGear = ThisWorkbook.Worksheets("Process & Torch")
Set wsControls = ThisWorkbook.Worksheets("Controls")
Set wsMaterialFlow = ThisWorkbook.Worksheets("Mat. Flow")
Set wsModular = ThisWorkbook.Worksheets("Modular")
Set wsSpotWeld = ThisWorkbook.Worksheets("Spot_Weld")
Set wsCustom = ThisWorkbook.Worksheets("Custom")
Set wsFG0100 = ThisWorkbook.Worksheets("FG-0100")
Set wsFG0200 = ThisWorkbook.Worksheets("FG-0200")
Set wsFG0300 = ThisWorkbook.Worksheets("FG-0300")
Set wsFG0400 = ThisWorkbook.Worksheets("FG-0400")
Set wsFG0500 = ThisWorkbook.Worksheets("FG-0500")
Set wsFG0600 = ThisWorkbook.Worksheets("FG-0600")
Set wsFG0700 = ThisWorkbook.Worksheets("FG-0700")
Set wsFG0800 = ThisWorkbook.Worksheets("FG-0800")
Set wsFG0900 = ThisWorkbook.Worksheets("FG-0900")
Set wsFG1000 = ThisWorkbook.Worksheets("FG-1000")
Set wsFG1100 = ThisWorkbook.Worksheets("FG-1100")
Set wsFG1200 = ThisWorkbook.Worksheets("FG-1200")
Set wsFG1300 = ThisWorkbook.Worksheets("FG-1300")
Set wsFG1400 = ThisWorkbook.Worksheets("FG-1400")
Set wsFG1500 = ThisWorkbook.Worksheets("FG-1500")
Set wsFG1600 = ThisWorkbook.Worksheets("FG-1600")
Set wsFG1700 = ThisWorkbook.Worksheets("FG-1700")
Set wsFG1800 = ThisWorkbook.Worksheets("FG-1800")
Set wsFG1900 = ThisWorkbook.Worksheets("FG-1900")
Set wsFG2000 = ThisWorkbook.Worksheets("FG-2000")
Set wsFG2100 = ThisWorkbook.Worksheets("FG-2100")
Set wsFG2200 = ThisWorkbook.Worksheets("FG-2200")
Set wsFG2300 = ThisWorkbook.Worksheets("FG-2300")
Set wsFG2400 = ThisWorkbook.Worksheets("FG-2400")


' FG-0100
' Platform

' Unhide/Select Function Group Sheet
Sheets("FG-0100").Visible = True
Sheets("FG-0100").Select
Sheets("FG-0100").Unprotect (CAT_PROTECT)
wsFG0100.Range("A5").Value = "FG-0100"

' Find the last row in column A of each worksheet
lastRow = wsPlatform.Cells(wsPlatform.Rows.Count, "A").End(xlUp).Row

' Loop through each row in column J of each worksheet
For i = 1 To lastRow
If wsPlatform.Cells(i, "J").Value = "FG0100" And wsPlatform.Cells(i, "B").Value >= 1 Then
' Find the next available row in column A of wsFG0100
j = wsFG0100.Cells(wsFG0100.Rows.Count, "A:K").End(xlUp).Row + 1

' Copy the value from column A of wsPlatform to wsFG0100

ActiveSheet.Unprotect (CAT_PROTECT)

wsPlatform.Cells(i, "A:K").Copy wsFG0100.Cells(j, "A:K")

ActiveSheet.Protect (CAT_PROTECT)

End If

Next i

End Sub