transporting data using For each cell

[Hlatigo]

Good morning all!

I am trying to pull in a table one column at a time from each worksheet and paste it in the worksheet("Main"). I have the code below to find the last row with data and then past it right underneath the next cell without data on the worksheet("main"). I have used something like the below before but for some reason I cant get it to work on this project. It errors out saying disqualifyer. on "X = .cells"

thanks for your help in advance.

For Each wsSheet In Worksheets
    'lastrow = Range("a65536").End(xlUp).Row
    lastrow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 10000
    x = .Cells(Rows.Count, 15).End(xlUp).Row

            If UCase(wsSheet.Name) <> "MAIN" Then
                For Each Cell In Range("D6:D" & lastrow)
                    If IsEmpty(Cell.Value) = False Then
                        ActiveCell.Copy
                        Worksheets("Main").Activate
                        x
                        ActiveSheet.Paste
                     
                     End If
                 Next wsSheet
                     
           End If

 

[Hlatigo]

I have made some changes to my code and it appears to be in the right direction but although it takes some what of the data on one of the sheets it is no where near being acurate. It seems to take all values and then paste them on main sheet at once and it doesnt pull all values from each sheet from column D. any help would be awesome.

Sub red()


    lastrow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count
   

            
        For Each wsSheet In Worksheets
            If UCase(wsSheet.Name) <> "MAIN" Then
                For Each Cell In Range("D8:D" & lastrow)
                    If Cell.Value <> "" Then
                        ActiveCell.Copy
                        Worksheets("Main").Activate
                        Range("O65536").End(xlUp).Offset(1, 0).Activate
                        ActiveSheet.Paste
                     
                     End If
                 Next Cell
                     
           End If
     Next wsSheet
     
End Sub

 

[DonkeyOte]

Hey, just to clarify you want to cycle each sheet (not MAIN) copy non-blanks from Column D to next empty row on MAIN in column O it seems (?)

Do you want to paste just values etc ?

When this fires should MAIN be empty or are you continuously appending data to O ?
ie you run now with MAIN emtpy and it populates MAIN ... you run tomorrow ... do you first clear MAIN or do you add to it ?

 

[Hlatigo]

Yes you are correct. with all of the above and I would like the data to be deleted everytime i run this but this isn't needed.

ooops...yes pasting just values is perfect

thanks!

 

[DonkeyOte]

Could probably be streamlined using a filter but should get you going...

Sub MAIN_D_SWEEP()
Dim ws As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim rng As Range
Sheets("MAIN").Columns(15).Clear
For Each ws In ActiveWorkbook.Worksheets
    Select Case UCase(ws.Name)
        Case "MAIN"
            'do nothing
        Case Else
            On Error Resume Next
            Set rng1 = ws.Columns(4).SpecialCells(xlCellTypeFormulas)
            Set rng2 = ws.Columns(4).SpecialCells(xlCellTypeConstants)
            On Error GoTo 0
            Select Case rng1 Is Nothing
                Case True
                    If rng2 Is Nothing = False Then Set rng = rng2
                Case False
                    If rng2 Is Nothing = True Then
                        Set rng = rng1
                    Else
                        Set rng = Union(rng1, rng2)
                    End If
            End Select
            rng.Copy
            Sheets("MAIN").Cells(Rows.Count, 15).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, SkipBlanks:=True
    End Select
Next ws
End Sub

 

[Hlatigo]

hi Lasw10!

Thanks so much for the code...the piece of code that is copying the whole colum D has one little issue. The column has a header and there is some non-desired data above the the column header. Column heading is on row 7. do you think i should use a xlup.end

Set rng1 = ws.Columns(4).SpecialCells(xlCellTypeFormulas)
Set rng2 = ws.Columns(4).SpecialCells(xlCellTypeConstants)

thanks so very much

 

[DonkeyOte]

Slightly tweaked to handle possibility of no data to be copied etc... still not particularly elegant though...

Sub MAIN_D_SWEEP()
Dim ws As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim rng As Range
Sheets("MAIN").Columns(15).Clear
For Each ws In ActiveWorkbook.Worksheets
    Select Case UCase(ws.Name)
        Case "MAIN"
            'do nothing
        Case Else
            On Error Resume Next
            ws.Select
            Set rng1 = ws.Range(Cells(8, 4), Cells(Rows.Count, 4)).SpecialCells(xlCellTypeFormulas)
            Set rng2 = ws.Range(Cells(8, 4), Cells(Rows.Count, 4)).SpecialCells(xlCellTypeConstants)
            On Error GoTo 0
            Select Case rng1 Is Nothing
                Case True
                    If rng2 Is Nothing = False Then
                        Set rng = rng2
                    Else
                        GoTo 10
                    End If
                Case False
                    If rng2 Is Nothing = True Then
                        Set rng = rng1
                    Else
                        Set rng = Union(rng1, rng2)
                    End If
            End Select
            rng.Copy
            Sheets("MAIN").Cells(Rows.Count, 15).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, SkipBlanks:=True
    End Select
10
Next ws
Sheets("MAIN").Select
End Sub

 

[Hlatigo]

Looking good, the odd thing is that it is doubling the second to the last worksheet when the last sheet doesnt have data in it.

for example the last two sheets are called SanFran and Portland. when portland has data everything runs smoothly. but if portland does not have data then SanFran will double its data. then if SanFran doesnt have data the sheet before it is LA and it will triple. so as you get cloder to the first sheet, the file is multiplied by the blank sheets behind it. this is one interesting issue. hehehe

any ideas?

 

[DonkeyOte]

Yes, once again, poor code on my part - sorry -- short sighted with the error handling... need to reset each range before moving to next sheet

between 10 and Next ws add the following so you have:

10
Set rng = Nothing
Set rng1 = Nothing
Set rng2 = Nothing
Next ws

 

[Hlatigo]

BEAUTIFUL!!! thanks a million


cheers!