Copy and paste data from multiple tables

[Galley]

I am storing user entered values in tables 2, 3 and 4. The tables are fixed sizes, but tables 3 and 4 may not have any data. The user is prevented from entering any more data than the table size allows.

Table #1 Product Info AI3:AM3 (1 row)
Table #2 Labor Costs AO3:AT10 (1-8 rows)
Table #3 Materials Costs AV3:AY9 (0-7 rows)
Table #4 Inspected Product BA3:BC9 (0-7 rows)

I need to export the information in the tables into another spreadhseet. For testing purposes, I am using Sheet2. I need to loop through each table (in the order listed above) and copy the values to the appropriate columns on Sheet2, but the data in Table #1 has to be inserted into each row.

Copy Product Info, paste to first empty row in A:E. Copy first row in Labor Costs, paste to the same row in F:K
Repeat for rest of Labor Costs table

Copy Product Info, paste to first empty row in A:E. Copy first row in Materials Costs, paste to the same row in L:O
Repeat for rest of MaterialsCosts table

Copy Product Info, paste to first empty row in A:E. Copy first row in Inspected Product, paste to the same row in P:R
Repeat for rest of Inspected Product table

The results should look like this, assuming each table had two rows of data.

A​

B​

C​

D​

E​

F​

G​

H​

I​

J​

K​

L​

M​

N​

O​

P​

Q​

R​

PI​

PI​

PI​

PI​

PI​

LC​

LC​

LC​

LC​

LC​

LC​

PI​

PI​

PI​

PI​

PI​

LC​

LC​

LC​

LC​

LC​

LC​

PI​

PI​

PI​

PI​

PI​

MC​

MC​

MC​

MC​

PI​

PI​

PI​

PI​

PI​

MC​

MC​

MC​

MC​

PI​

PI​

PI​

PI​

PI​

IP​

IP​

IP​

PI​

PI​

PI​

PI​

PI​

IP​

IP​

IP​

<TBODY>
</TBODY>

I have been testing the following code for the first two tables, but it doesn't loop. I suck at looping!

Sub Export_Product_Info()
Dim FirstBlankCell As Range
   
'Copy Product Info

Sheets("Sheet1").Select
     
'Selects data in Product Info table
    Range("AI3:AM3").Select
    Selection.Copy
      
'Pastes data in columns A thru E
    Sheets("Sheet2").Select
    
    Set FirstBlankCell = Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    FirstBlankCell.Activate
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False

  '#############################' 
       
'Copy Labor Costs
   
Sheets("Sheet1").Select
   
     'Selects data in Labor Costs table
    Range("AO3:AT3").Select
    Selection.Copy
      
'Pastes data in columns F thru K
    Sheets("Sheet2").Select
   
    Set FirstBlankCell = Range("F" & Rows.Count).End(xlUp).Offset(1, 0)
    FirstBlankCell.Activate
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    
     End If
     
End Sub

 

[Galley]

I have since discovered the .CurrentRegion method, which copies an entire table. I reconfigured my table to be 18 contiguous coumns of 8 rows, but some of the columns contain formulas. The .CurrentRegion method copies all 8 rows in the table, since it the region is based on blank cells. D'oh!

Sub Copy_Table()
'Copies contents of table in Sheet1 beginning at A2 and appends to Sheet2
Dim Src As Range
Dim Dest As Range
'set source, exclude first row, beginning in column A
Set Src = Worksheets("Sheet1").Range("A2").CurrentRegion.Offset(1, 0)
'destination is one row below last row, beginning in column 1
Set Dest = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Src.Copy Destination:=Dest
End Sub

I also need to use the following .PasteSpecial method to match the destination formatting.

Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False

 

[Galley]

I have been wracking my brain trying to figure this one out. The following code works, but if any of the rows contain formulas, those rows are also copied. That results in blank rows being pasted into Sheet2.

As an example, cell A6 contains the formula =IF(F6<>0,TODAY(),"") In other words, if F6 is blank, then A6 should be blank. How do I ignore cells with formulas that return a zero-length value? Columns B:E have similar formulas to ensure that for every entry in columns F:R, the appropriate data will be displayed in A:E.


What about SpecialCells? I haven't had any luck with that method. Thanks

Sub Copy_Table()
    Dim Src As Range
    Dim Dest As Range
    
    'set source, exclude first row
    Set Src = Worksheets("Sheet1").Range("A2").CurrentRegion.Offset(1, 0)
    
    'destination is one row below last row, beginning with column 1
    Set Dest = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    
    Src.Copy
    
    Dest.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
End Sub

 

[Galley]

What I ended up doing was writing the Product Info to columns A:E, before the data is exported. I had already been using the last row number in columns F, L and P for an undo function that I wrote. I then use the largest of those three numbers to loop through A:E the approriate number of times.

Consider this one solved!