statements to copy and paste from one sheet to another

**Tortus** · 09-23-2009, 11:57 AM

Posted this about a year ago.

http://www.excelforum.com/excel-prog...-workbook.html

This is an add to request! I can't figure it out how to do this.

Sheet2, Sheet4, Sheet6, Sheet8, Sheet10, Sheet12, Sheet14, Sheet16, Sheet18, Sheet20, Sheet22, Sheet24, Sheet26, Sheet28, Sheet30, Sheet32, Sheet34, Sheet36, Sheet38

If G8 = “E” and if F8 = “H” and E8 is >=10 Copy A8:G8 and paste to sheet tab Sheet40.

If G8 = “E” and if F8 = “E” and E8 is >=1 Copy A8:G8 and paste to sheet tab Sheet40.

If G8 = “E” and if F8 = “L” and E8 is >=20 Copy A8:G8 and paste to sheet tab Sheet40.

When at anytime “D” is in G8, do nothing.

These conditions would be for each row from 8 – 3000 down the page

Thank you guys!

**davegugg** · 09-23-2009, 12:34 PM

Does this work for you?

Public Sub Tortus()

Dim FirstLastRow As Long
Dim Sht40LastRow As Long

FirstLastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

For i = 8 To FirstLastRow
    Sht40LastRow = Sheets("Sheet40").Cells(Rows.Count, 1).End(xlUp).Row + 1
    If ActiveSheet.Cells(8, 7).Value = "E" Then
        Select Case ActiveSheet.Cells(8, 6).Value
            Case "H"
                If ActiveSheet.Cells(8, 5).Value >= 10 Then
                    ActiveSheet.Range("A8:G8").Copy Destination:=Sheets("Sheet40").Cells(Sht40LastRow, 1)
                End If
            Case "E"
                If ActiveSheet.Cells(8, 5).Value >= 1 Then
                    ActiveSheet.Range("A8:G8").Copy Destination:=Sheets("Sheet40").Cells(Sht40LastRow, 1)
                End If
            Case "L"
                If ActiveSheet.Cells(8, 5).Value >= 20 Then
                    ActiveSheet.Range("A8:G8").Copy Destination:=Sheets("Sheet40").Cells(Sht40LastRow, 1)
                End If
        End Select
    End If
Next i

End Sub

**Tortus** · 09-23-2009, 01:37 PM

This code doesn't run. I don't get any error. Maybe I'm doing something wrong. I assigned the code to a button on Sheet40. Does it matter?

**davegugg** · 09-23-2009, 01:41 PM

Yes, that matters. You should be on whichever sheet you want to run it for.
... Actually, now that I reread your original request, did you want it to run on all even sheet numbers?

**Tortus** · 09-23-2009, 01:55 PM

Just the sheets listed. There are more sheets in the workbook that don't apply.

**davegugg** · 09-23-2009, 02:42 PM

Ok, let me know how this works for you. Put the code in a standard module:

Public Sub Tortus()

Dim FirstLastRow As Long
Dim Sht40LastRow As Long
Dim arrSht(19) As String

For a = 2 To 38 Step 2
    arrSht(a / 2) = "Sheet" & a
Next a

For j = 1 To 19
    Sheets(arrSht(j)).Activate
    FirstLastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 8 To FirstLastRow
        Sht40LastRow = Sheets("Sheet40").Cells(Rows.Count, 1).End(xlUp).Row + 1
        If ActiveSheet.Cells(8, 7).Value = "E" Then
            Select Case ActiveSheet.Cells(8, 6).Value
                Case "H"
                    If ActiveSheet.Cells(8, 5).Value >= 10 Then
                        ActiveSheet.Range("A8:G8").Copy Destination:=Sheets("Sheet40").Cells(Sht40LastRow, 1)
                    End If
                Case "E"
                    If ActiveSheet.Cells(8, 5).Value >= 1 Then
                        ActiveSheet.Range("A8:G8").Copy Destination:=Sheets("Sheet40").Cells(Sht40LastRow, 1)
                    End If
                Case "L"
                    If ActiveSheet.Cells(8, 5).Value >= 20 Then
                        ActiveSheet.Range("A8:G8").Copy Destination:=Sheets("Sheet40").Cells(Sht40LastRow, 1)
                    End If
            End Select
        End If
    Next i
Next j

End Sub

**Tortus** · 09-23-2009, 03:02 PM

Sorry.. I screwed up. I was looking at the VBAProject when I listed the names of the sheets.. The sheets are actualy named sheets. Do you need the name of each sheet. I can't believe I listed Sheet2...etc.

**davegugg** · 09-23-2009, 04:10 PM

If the sheets will always have the VBAProject names of 2 - 38 (evens only) then it is actually easier. Just change to this:

Public Sub Tortus()

Dim FirstLastRow As Long
Dim Sht40LastRow As Long

For j = 2 To 38 Step 2
    Sheets(j).Activate
    FirstLastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 8 To FirstLastRow
        Sht40LastRow = Sheets("Sheet40").Cells(Rows.Count, 1).End(xlUp).Row + 1
        If ActiveSheet.Cells(8, 7).Value = "E" Then
            Select Case ActiveSheet.Cells(8, 6).Value
                Case "H"
                    If ActiveSheet.Cells(8, 5).Value >= 10 Then
                        ActiveSheet.Range("A8:G8").Copy Destination:=Sheets("Sheet40").Cells(Sht40LastRow, 1)
                    End If
                Case "E"
                    If ActiveSheet.Cells(8, 5).Value >= 1 Then
                        ActiveSheet.Range("A8:G8").Copy Destination:=Sheets("Sheet40").Cells(Sht40LastRow, 1)
                    End If
                Case "L"
                    If ActiveSheet.Cells(8, 5).Value >= 20 Then
                        ActiveSheet.Range("A8:G8").Copy Destination:=Sheets("Sheet40").Cells(Sht40LastRow, 1)
                    End If
            End Select
        End If
    Next i
Next j

End Sub

Otherwise you can name each sheet in the array manually. For example:

arrSht(1) = "Name1"
arrSht(2) = "Name2"
...

**Tortus** · 09-24-2009, 11:43 AM

The original code works except it does not look in G for "D" nor does it include "L" in F.

If G8 = “E” and if F8 = “H” and E8 is >=10 Copy A8:G8 and paste to sheet tab Sheet40.

If G8 = “E” and if F8 = “E” and E8 is >=1 Copy A8:G8 and paste to sheet tab Sheet40.

If G8 = “E” and if F8 = “L” and E8 is >=20 Copy A8:G8 and paste to sheet tab Sheet40.

When at anytime “D” is in G8, do nothing.

If Left(Worksheets(x).Range("F8").Cells(y, 1), 1) = "E" Or _
                Left(Worksheets(x).Range("F8").Cells(y, 1), 1) = "H" And _
                Worksheets(x).Range("E8").Cells(y, 1) >= 9 Then
                    Worksheets(x).Range(Worksheets(x).Range("B8").Cells(y, 1), Worksheets(x).Range("F8").Cells(y, 1)).Copy
                        Worksheets("E&H").Range("a100").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteAll)
                        Worksheets("E&H").Range("a100").End(xlUp).Offset(0, 5) = dDate
                        Worksheets("E&H").Range("a100").End(xlUp).Offset(0, 6) = stTab

I don't know what to do... Maybe write 2 codes and use Application.Run - the other macro name or something

**davegugg** · 09-24-2009, 12:50 PM

I didn't read your previous thread. Does my code not work?

**Tortus** · 09-24-2009, 02:40 PM

No, I can't get it to work.

**davegugg** · 09-24-2009, 02:59 PM

Well, what line produces an error?

statements to copy and paste from one sheet to another

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

statements to copy and paste from one sheet to another

Re: statements to copy and paste from one sheet to another

Re: statements to copy and paste from one sheet to another

Re: statements to copy and paste from one sheet to another

Re: statements to copy and paste from one sheet to another

Re: statements to copy and paste from one sheet to another

Re: statements to copy and paste from one sheet to another

Re: statements to copy and paste from one sheet to another

Re: statements to copy and paste from one sheet to another

Re: statements to copy and paste from one sheet to another

Re: statements to copy and paste from one sheet to another

Re: statements to copy and paste from one sheet to another

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions