merge range from 8 worksheets into one range

[darthbane]

Hello everyone,
I hope you guys can help me with this problem i am having that I need a VBA solution to!

i have 8 worksheets (worksheets 8-15) that I need to be copied over to workheet3 ("RevRel")

the data in all 8 worksheets has the same amount of columns (A:O) starting from A1 but vary in number of rows.
I need a vba solution that starts from sheet 8 copies the data as a value only up until Column A cell is blank and then it moves onto sheet 9 copies the data there etc
and all 8 sheets need to be copied to RevRel with sheet 8 being first, then sheet 9 etc.

example of data start at A1

[TABLE="width: 500"]
<tbody>[TR]
[TD]open[/TD]
[TD]dec 1[/TD]
[TD]andy[/TD]
[TD]checked[/TD]
[TD]yes[/TD]
[TD]no[/TD]
[TD]yes[/TD]
[TD]no[/TD]
[TD]no[/TD]
[TD]no[/TD]
[TD]yes[/TD]
[TD]no[/TD]
[TD]no[/TD]
[TD]yes[/TD]
[TD]no[/TD]
[/TR]
[TR]
[TD]closed[/TD]
[TD]dec 2[/TD]
[TD]dwight[/TD]
[TD]not checked[/TD]
[TD]no[/TD]
[TD][/TD]
[TD]yes[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]no[/TD]
[TD]no[/TD]
[TD]no[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]open[/TD]
[TD]dec 5[/TD]
[TD]micheal[/TD]
[TD]checked[/TD]
[TD]yes[/TD]
[TD]yes[/TD]
[TD]no[/TD]
[TD]no[/TD]
[TD][/TD]
[TD]no[/TD]
[TD][/TD]
[TD][/TD]
[TD]no[/TD]
[TD]no[/TD]
[TD]yes[/TD]
[/TR]
[TR]
[TD]closed[/TD]
[TD]dec 10[/TD]
[TD]jim[/TD]
[TD]not checked[/TD]
[TD]yes[/TD]
[TD]no[/TD]
[TD][/TD]
[TD][/TD]
[TD]no[/TD]
[TD]yes[/TD]
[TD]yes[/TD]
[TD]no[/TD]
[TD]yes[/TD]
[TD]no[/TD]
[TD]yes[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

columns 5-15 could have yes or no, or could be left blank
i want the macro to find the row that has column A blank as that will never be blank if there is data

the data is linked from different workbooks and has a formula behind it (IF(b8=0, "",b8) so i dont want that to be copied just the value that is outputted.

if you need the sheet names they are
burgundy
charcoal
emerald
magenta
navy
ruby
sapphire
violet

any easy solution to this problem was creating a query and connecting the workbooks which i normally would do but cannot in this case.
please help!!

 

[darthbane]

edit:
the ranges from worksheets 8-15 will have data (formulas like mentioned above) until row 6000. most of these will be outputting " " until data is filled in their respective workbooks.

 

[JoeMo]

Untested, but see if this works for you.

Sub darthbane()
Dim ShtNames As Variant, Sht  As Worksheet, lR As Long, nR As Long
ShtNames = Array("burgundy", "charcoal", "emerald", "magenta", "navy", "ruby", "sapphire", "violet")
Application.ScreenUpdating = False
For Each Sht In Worksheets(ShtNames)
       lR = Sht.Range("A" & Rows.Count).End(xlUp).Row
       nR = Sheets("RevRel").Range("A" & _
           Rows.Count).End(xlUp).Offset(IIf(IsEmpty(Sheets("RevRel").Range("A1")), _
           0, 1), 0).Row
       Sht.Range("A1:O" & lR).Copy
       Sheets("RevRel").Range("A" & nR).PasteSpecial Paste:=xlPasteValues
Next Sht
With Application
       .CutCopyMode = False
       .ScreenUpdating = True
End With
End Sub

 

[darthbane]

Untested, but see if this works for you.

Sub darthbane()
Dim ShtNames As Variant, Sht  As Worksheet, lR As Long, nR As Long
ShtNames = Array("burgundy", "charcoal", "emerald", "magenta", "navy", "ruby", "sapphire", "violet")
Application.ScreenUpdating = False
For Each Sht In Worksheets(ShtNames)
       lR = Sht.Range("A" & Rows.Count).End(xlUp).Row
       nR = Sheets("RevRel").Range("A" & _
           Rows.Count).End(xlUp).Offset(IIf(IsEmpty(Sheets("RevRel").Range("A1")), _
           0, 1), 0).Row
       Sht.Range("A1:O" & lR).Copy
       Sheets("RevRel").Range("A" & nR).PasteSpecial Paste:=xlPasteValues
Next Sht
With Application
       .CutCopyMode = False
       .ScreenUpdating = True
End With
End Sub

the code you provided partially works. it does paste the ranges to worksheet "RevRel' but it copys to A7. Whereas I need it to start at A8.
Also it copys the entire range including the blank values.
so sheet burgundy is copied from a:1-O:6000 but there is only data in the first 5 rows at the moment.
I need it to ignore the cells that output a " " value as I mentioned the ranges in each worksheet all have data(formula with IF statement) but I only want it to copy rows that have a value in column A that isn't a blank or " "

I hope that makes sense. and THANK YOU for the quick response this is the closest I have gotten to finding a solution !!

 

[JoeMo]

the code you provided partially works. it does paste the ranges to worksheet "RevRel' but it copys to A7. Whereas I need it to start at A8.
Also it copys the entire range including the blank values.
so sheet burgundy is copied from a:1-O:6000 but there is only data in the first 5 rows at the moment.
I need it to ignore the cells that output a " " value as I mentioned the ranges in each worksheet all have data(formula with IF statement) but I only want it to copy rows that have a value in column A that isn't a blank or " "

I hope that makes sense. and THANK YOU for the quick response this is the closest I have gotten to finding a solution !!

Two questions:
1. Prior to any pasting to RevRel, does RevRel already have filled cells in col A? If yes, what is the address of the last filled cell in col A?
2. Do the formulas in col A of the sheets you want to copy from return " " (a space as you indicated in your post) or is it actually "" ( a zero-length string)?

 

[darthbane]

thanks for the response
1. yes it does, the only filled cell in Col A is A7 ("policy type")
2. it returns a "" not a space sorry for the confusion the formula in the sheets that i want to copy are =IF('[pc-team-burgundy.xlsm]RevRel'!A8=0,"",'[pc-team-burgundy.xlsm]RevRel'!A8)

hope that helps!

 

[JoeMo]

That helps although I'm uncertain if the workbook pc-team-burgundy.xlsm is the same workbook that has the sheets you want to copy(?). Meanwhile, I'll take a guess - see if this works for you:

Sub darthbane()
Dim ShtNames As Variant, Sht  As Worksheet, lR As Long, c As Range, nR As Long
ShtNames = Array("burgundy", "charcoal", "emerald", "magenta", "navy", "ruby", "sapphire", "violet")
With Application
       .ScreenUpdating = False
       .Calculation = xlCalculationManual
End With
For Each Sht In Worksheets(ShtNames)
       lR = Sht.Range("A" & Rows.Count).End(xlUp).Row
       For Each c In Sht.Range("A1:A" & lR).SpecialCells(xlCellTypeFormulas)
              If c.Value <> "" Then
                     nR = Sheets("RevRel").Range("A" & Rows.Count).End(xlUp).Row + 1
                     Sht.Range("A" & c.Row, "O" & c.Row).Copy
                     Sheets("RevRel").Range("A" & nR).PasteSpecial Paste:=xlPasteValues
              End If
       Next c
Next Sht
With Application
       .CutCopyMode = False
       .Calculation = xlCalculationAutomatic
       .ScreenUpdating = True
End With
End Sub

 

[darthbane]

yes this works perfectly!! Thank you!

the pc-team-burgundy.xlsm has the burgundy sheet i want to copy. pc-team-charcoal.xlsm has the charcoal sheet etc.

one thing however, if i run the code twice it copys the same data underneath it (making a duplicate basically) I was hoping this wouldnt happen as I was going to make a button for this macro for others to use. but this is a small annoyance (one i can probably fix with a macro to delete value in the range)