VBA to check 2 cells of data and then copy and paste from multiple sheets to the data sheet

[danbates77]

Hi,

I have 7 palletisers at work. G, H, J, K, L, M and N.

Each palletiser has 40 programs. The settings for the programs are listed below each number, so program 1 from each palletiser is in range C3:C38. Program 2 is range D3:D38 and so on.

What I would like to try and do is when I enter the palletiser letter in cell C1 and the palletiser program number in cell C2 on my "DATA" sheet (via data validation) it will then copy and paste that palletiser number settings from each palletiser onto my "DATA" sheet moving across the sheet from column C.

I hope this makes sense but if not then please ask.

I appreciate any help with this.

Thanks
Dan

 

[vmjan02]

@danbates77
I haven't tested it, just give it a try.

Option Explicit

Sub All_Palletisers()

    Dim myRGB_Red As Long: myRGB_Red = RGB(255, 0, 0)
    Dim myRGB_Yellow As Long: myRGB_Yellow = RGB(255, 255, 0)
    Dim myRGB_Blue As Long: myRGB_Blue = RGB(0, 112, 192)
    Dim myRGB_Amber As Long: myRGB_Amber = RGB(255, 192, 0)
    Dim myRGB_Green As Long: myRGB_Green = RGB(0, 176, 80)
    Dim myRGB_Purple As Long: myRGB_Purple = RGB(112, 48, 160)
    Dim myRGB_Orange As Long: myRGB_Orange = RGB(237, 125, 49)
    Dim myRGB_Grey As Long: myRGB_Grey = RGB(166, 166, 166)
    
    Dim palletisers As Variant
    Dim palletiser As Variant
    Dim programNumber As Integer
    Dim i As Integer
    Dim sourceRange As Range
    Dim destColumn As Integer
    
    ' Define the palletisers
    palletisers = Array("G", "H", "J", "K", "L", "M", "N")
    
    ' Get the selected program number from C2
    programNumber = Range("C2").Value
    
    ' Check if the program number is valid
    If programNumber < 1 Or programNumber > 40 Then
        MsgBox "Please select a valid program number between 1 and 40."
        Exit Sub
    End If
    
    ' Start from column D (4th column), since column C is already used
    destColumn = 4
    
    ' Copy the existing data in column C to the first destination column
    Sheets("DATA").Range("C4:C38").Copy
    Sheets("DATA").Cells(4, 3).PasteSpecial Paste:=xlPasteValues
    ' Clear any existing formatting in the destination range
    Sheets("DATA").Cells(4, 3).Resize(35).Interior.ColorIndex = xlNone
    
    ' Loop through each palletiser
    For i = LBound(palletisers) To UBound(palletisers)
        palletiser = palletisers(i)
        
        ' Define the source range based on the program number
        Set sourceRange = Sheets(palletiser).Range(Sheets(palletiser).Cells(3, 2 + programNumber), Sheets(palletiser).Cells(38, 2 + programNumber))
        
        ' Copy the source range
        sourceRange.Copy
        
        ' Paste the values in the corresponding column on the "DATA" sheet
        With Sheets("DATA")
            .Cells(4, destColumn).PasteSpecial Paste:=xlPasteValues
            ' Optionally, you can also clear any existing formatting
            .Cells(4, destColumn).Resize(35).Interior.ColorIndex = xlNone
        End With
        
        ' Increment the destination column
        destColumn = destColumn + 1
    Next i
    
    ' Color the selected cells in the header
    With Worksheets("DATA")
        .Range(.Cells(2, 3), .Cells(2, destColumn - 1)).Interior.Color = myRGB_Red
    End With
    
    ' Clear the clipboard
    Application.CutCopyMode = False

End Sub

 

[danbates77]

Hi,

I've added a picture so you can see but It is now not filling out column C with any data regardless of which palletiser and number I select.

It fills out the 7 columns from D

Thanks again
Dan