transporting data using For each cell

Hlatigo

Well-known Member
Joined
Jun 3, 2002
Messages
677
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.

Code:
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
 

Some videos you may like

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

Hlatigo

Well-known Member
Joined
Jun 3, 2002
Messages
677
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.

Code:
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

MrExcel MVP
Joined
Sep 6, 2002
Messages
9,123
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

Well-known Member
Joined
Jun 3, 2002
Messages
677
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

MrExcel MVP
Joined
Sep 6, 2002
Messages
9,123

ADVERTISEMENT

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

Code:
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

Well-known Member
Joined
Jun 3, 2002
Messages
677
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

MrExcel MVP
Joined
Sep 6, 2002
Messages
9,123

ADVERTISEMENT

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

Code:
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

Well-known Member
Joined
Jun 3, 2002
Messages
677
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

MrExcel MVP
Joined
Sep 6, 2002
Messages
9,123
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:

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

Watch MrExcel Video

Forum statistics

Threads
1,123,317
Messages
5,600,912
Members
414,415
Latest member
joshuaba

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top