How can I make this code more efficient?

I am running the following macro....but it takes forever to finish. My thought is that it's the first part (looking up all rows & columns even if there aren't any values). Would making this a dynamic range help? Any VBA wiz out there that can help me?

Private Sub CommandButton1_Click()
'Fill In Assortment Info

Dim intSheet3Row As Integer
Dim intSheet3Column As Integer

For intSheet3Column = 1 To 75
    For intSheet3Row = 1 To 340
        If Sheet2.Cells(intSheet3Row, intSheet3Column).Interior.Color <> vbBlack Then
            Sheet3.Cells(intSheet3Row, intSheet3Column).Value = Sheet2.Cells(intSheet3Row, intSheet3Column).Value
        End If
    Next intSheet3Row
Next intSheet3Column

'Format Assortment Info
Range("A1:A13").Select
With Selection
    .HorizontalAlignment = xlRight
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With
    'My Company, My Division
    Range("B1:B2").Select
    Selection.NumberFormat = "00"
    'Brand, Corporation, Account Name
    Range("B3:B5").Select
    Selection.NumberFormat = "General"
    'Account Number
    Range("B6").Select
    Selection.NumberFormat = "0000000"
    'Account Dept
    Range("B7").Select
    Selection.NumberFormat = "000"
    'PO Number
    Range("B8").Select
    Selection.NumberFormat = "0000000"
    'Start Date, Cancel Date
    Range("B9:B10").Select
    Selection.NumberFormat = "mm/dd/yyyy"
    'Cost, Owned Price, Ticket Price
    Range("B11:B13").Select
    Selection.NumberFormat = "$#,##0.00"
    'Color Number
    Columns("C:C").Select
    Selection.NumberFormat = "000"
    'Color Name
    Columns("D:D").Select
    Selection.NumberFormat = "General"
    'UPC Code
    Columns("E:E").Select
    Selection.NumberFormat = "000000000000"
    'Store Numbers
    Range("F1:AN30").Select
    Selection.NumberFormat = "0000"
    'Non-Data Cell
    Range("A23").Select
    
End Sub

Thanks for your help!

Hello Mr.Whiskers,

This will run much faster.

Private Sub CommandButton1_Click()
'Fill In Assortment Info

    Dim C As Long
    Dim Cell As Range
    Dim Data As Variant
    Dim R As Long
    Dim Rng As Range

        Set Rng = Sheet2.Range("A1:BW340")
        
        ReDim Data(1 To Rng.Rows.Count, 1 To Rng.Columns.Count)
                
        Data = Sheet3.Range(Rng.Address).Value
        
        For C = 1 To 75
            For R = 1 To 340
                If Rng.Item(R, C).Interior.Color <> vbBlack Then
                    Data(R, C) = Rng.Item(R, C).Value
                End If
            Next R
        Next C

        Sheet3.Range(Rng.Address).Value = Data
        
        
        With Range("A1:A13")
            .HorizontalAlignment = xlRight
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        
      ' My Company, My Division
        Range("B1:B2").NumberFormat = "00"
      ' Brand, Corporation, Account Name
        Range("B3:B5").NumberFormat = "General"
      ' Account Number
        Range("B6").NumberFormat = "0000000"
      ' Account Dept
        Range("B7").Selection.NumberFormat = "000"
      ' PO Number
        Range("B8").NumberFormat = "0000000"
      ' Start Date, Cancel Date
        Range("B9:B10").NumberFormat = "mm/dd/yyyy"
      ' Cost, Owned Price, Ticket Price
        Range("B11:B13").NumberFormat = "$#,##0.00"
      ' Color Number
        Columns("C:C").NumberFormat = "000"
      ' Color Name
        Columns("D:D").NumberFormat = "General"
      ' UPC Code
        Columns("E:E").NumberFormat = "000000000000"
      ' Store Numbers
        Range("F1:AN30").NumberFormat = "0000"
      ' Non-Data Cell
        Range("A23").Select

End Sub