Pasting as a Value Macro

ankrups

Board Regular
Joined
Mar 14, 2006
Messages
124
Office Version
  1. 2021
Platform
  1. Windows
Hi,

I need help from Macto Guru. Actually, I created one macro but that macro doesn't paste data as a value. So here is the code and eagarly waiting your help.
Code:
Sub foo()
    Dim ws As Worksheet
    Dim LastRow As Range
    
        For Each ws In ActiveWorkbook.Worksheets
            If ws.Name <> "IMPORT" And ws.Name <> "2007" And ws.Name <> "SKU_LIST" And ws.Name <> "AZTEC_Data" And ws.Name <> "National Customer" And ws.Name <> "Setup" And ws.Name <> "His_UT_Mth" And ws.Name <> "Legends" And ws.Name <> "Summary" Then
                                
                
                'w Key
                Set LastRow = Sheets("IMPORT").Cells(Rows.Count, "A").End(xlUp)
                ws.Range("DM49:DM51").Copy LastRow.Offset(1)
                
                
                
            End If
        Next ws
        
End Sub
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Hi,

Try this:
Code:
Sub foo()
Dim ws As Worksheet, wsImport As Worksheet
Dim lEndRow As Long

    Set wsImport = Sheets("IMPORT")
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> wsImport.Name _
        And ws.Name <> "2007" _
        And ws.Name <> "SKU_LIST" _
        And ws.Name <> "AZTEC_Data" _
        And ws.Name <> "National Customer" _
        And ws.Name <> "Setup" _
        And ws.Name <> "His_UT_Mth" _
        And ws.Name <> "Legends" _
        And ws.Name <> "Summary" Then
                            
            'w Key
            lEndRow = wsImport.Cells(Rows.Count, "A").End(xlUp).Row + 1
            wsImport.Range("A" & lEndRow, "A" & lEndRow + 2).Value = ws.Range("DM49:DM51").Value
            
            
            
        End If
    Next ws
        
End Sub
 
Upvote 0
Thanks for that Mate.This is exactly what I want.

BUT while doing R&D yesterday with this code, one another thing pop up. I also want to paste as a value Range of E49 to DD51 into Column B.

So, please again help me. :eek:
 
Upvote 0
Hi,

So do you want E49 to E51 then F49 to F51 then G49 to G51 ... DD49 to GG51 placing consecutively into column B, or do you want E49:DD51 values placing into columns B to DA?

If the former, try:
Code:
Sub foo()
Dim iStartCol As Integer, iEndCol As Integer, iCol As Integer
Dim lEndRow As Long
Dim ws As Worksheet, wsImport As Worksheet

    iStartCol = Range("E1").Column
    iEndCol = Range("DD1").Column
    
    Set wsImport = Sheets("IMPORT")
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> wsImport.Name _
        And ws.Name <> "2007" _
        And ws.Name <> "SKU_LIST" _
        And ws.Name <> "AZTEC_Data" _
        And ws.Name <> "National Customer" _
        And ws.Name <> "Setup" _
        And ws.Name <> "His_UT_Mth" _
        And ws.Name <> "Legends" _
        And ws.Name <> "Summary" Then
                            
            'w Key
            lEndRow = wsImport.Cells(Rows.Count, "A").End(xlUp).Row + 1
            wsImport.Range("A" & lEndRow, "A" & lEndRow + 2).Value = ws.Range("DM49:DM51").Value
            
            For iCol = iStartCol To iEndCol
                lEndRow = wsImport.Cells(Rows.Count, "B").End(xlUp).Row + 1
                wsImport.Range("B" & lEndRow, "B" & lEndRow + 2).Value = _
                        ws.Range(Cells(49, iCol).Address, _
                                 Cells(51, iCol).Address).Value
            Next iCol
            
            
        End If
    Next ws
        
End Sub

If the latter, try:
Code:
Sub foo2()
Dim iStartCol As Integer, iEndCol As Integer
Dim lEndRow As Long
Dim ws As Worksheet, wsImport As Worksheet

    iStartCol = Range("E1").Column
    iEndCol = Range("DD1").Column
    
    Set wsImport = Sheets("IMPORT")
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> wsImport.Name _
        And ws.Name <> "2007" _
        And ws.Name <> "SKU_LIST" _
        And ws.Name <> "AZTEC_Data" _
        And ws.Name <> "National Customer" _
        And ws.Name <> "Setup" _
        And ws.Name <> "His_UT_Mth" _
        And ws.Name <> "Legends" _
        And ws.Name <> "Summary" Then
                            
            'w Key
            lEndRow = wsImport.Cells(Rows.Count, "A").End(xlUp).Row + 1
            wsImport.Range("A" & lEndRow, "A" & lEndRow + 2).Value = ws.Range("DM49:DM51").Value
            wsImport.Range("B" & lEndRow, _
                           Cells(lEndRow + 2, iEndCol + 2 - iStartCol).Address).Value = _
                    ws.Range(Cells(49, iStartCol).Address, _
                             Cells(51, iEndCol).Address).Value
                        
        End If
    Next ws
        
End Sub
 
Upvote 0
Mate You are genious. The same code that I want.

Heartly thanking you mate.

See u soon.

-Ankit
 
Upvote 0

Forum statistics

Threads
1,213,532
Messages
6,114,176
Members
448,554
Latest member
Gleisner2

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
Back
Top