CODEWITHSUNDEEP
excelvba
Mile_Gargova
Mile_Gargova

Reputation: 1

How to copy range from multiple sheets to one sheet (one range under another) if a condition is met?

I have and excel workbook with multiple sheets and I need a range from each one to be copied into one "Main" sheet (one under another) if a condition is met.

  1. Each sheet is different and the number of rows and cells may vary.
  2. In all of the sheets (except the main sheet which is blank) cell B1 is a check cell that contains "yes" or is blank.
  3. If cell B1 ="yes" the macro must migrate the range (from row 2 to the lat filled in row) into the main sheet.
  4. The selected ranges must be copied one under another in the main sheet (so that it's like a list)

I am still a beginner in VBA and if anyone could help me a little with the code I would very much appreciate it :).

I tried to build in the code using "For Each - Next" but perhaps it would be better to make it with a Loop cicle or something else.

Sub Migrate_Sheets()  
    Dim wksh As Worksheet, DB_range As Range, end_row As Long, con_cell As Variant

    con_cell = Range("B1")
    'end_row = Range("1048576" & Rows.Count).End(xlUp).Rows

    For Each wksh In Worksheets
        If con_cell = "Yes" Then            
            Set DB_range = Range("2" & Rows.Count).End(xlDown).Rows 
            DB_range.Copy

            wksh("Main").Activate
            'row_end = Range("2" & Rows.Count).End(xlUp).Rows

            Range("A1").End(xlDown).Offset(1, 0).Paste   
        End If      
    Next wksh         
End Sub

Upvotes: 0

Views: 461

Answers (2)

FAB
FAB

Reputation: 2569

See if this helps, though you might need to make some minor changes to match your data sets..

Sub Migrate_Sheets()
    Dim wksh As Worksheet, mainWS As Worksheet
    Dim DB_range As Range, con_cell As String

    Dim lRow As Long, lCol As Long, lRowMain As Long

    Set mainWS = ThisWorkbook.Worksheets("Main")

    For Each wksh In Worksheets
        con_cell = wksh.Range("B1").Value         'You want to use this variable within the loop

        If wksh.Name <> "Main" And con_cell = "Yes" Then
            lRowMain = lastRC(mainWS, "row", 1) + 1     'Add 1 to the last value to get first empty row
            lRow = lastRC(wksh, "row", 1)               'Get the last row at column 1 - adjust to a different column if no values in column 1
            lCol = lastRC(wksh, "col", 2)               'Get the last column at row 2 - adjust to a different row if no values in row 2

            With mainWS
                .Range(.Cells(lRowMain, 1), .Cells(lRowMain + lRow - 1, lCol)).Value = wksh.Range(wksh.Cells(2, 1), wksh.Cells(lRow, lCol)).Value
            End With

        End If
    Next wksh
End Sub

Function lastRC(sht As Worksheet, RC As String, Optional RCpos As Long = 1) As Long

    If RC = "row" Then
      lastRC = sht.Cells(sht.Rows.Count, RCpos).End(xlUp).row

    ElseIf RC = "col" Then
      lastRC = sht.Cells(RCpos, sht.Columns.Count).End(xlToLeft).Column

    Else
        lastRC = 0

    End If
End Function

Upvotes: 0

SJR
SJR

Reputation: 23081

There are quite a few issues here - I suggest you do some reading on VBA basics - syntax, objects, methods etc.

I've assumed you are only copying column B.

Sub Migrate_Sheets()

Dim wksh As Worksheet, DB_range As Range

For Each wksh In Worksheets
    If wksh.Name <> "Main" Then 'want to exclude this sheet from the check
        If wksh.Range("B1").Value = "Yes" Then 'refer to the worksheet in the loop
            Set DB_range = wksh.Range("B2", wksh.Range("B" & Rows.Count).End(xlUp)) 'you need Set when assigning object variables
            DB_range.Copy Worksheets("Main").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) 'better to work up from the bottom and then go down 1
        End If
    End If
Next wksh

End Sub

Upvotes: 0

Related Questions