Paste to specific cell & keep row / column & width / height values

[ipbr21054]

Please can you advise.

The following code copies the selection on the worksheet Fine.
When i see it pasted its in cell A1 & the rows / columns are all squashed up.

Please can you advise how i can paste to the cell A10 & also keep row & column width / height values.

Thanks

Private Sub CommandButton100_Click()
 ActiveSheet.Range("F2:N61").Copy
 Sheets.Add(After:=Sheets(Sheets.Count)).NAME = Range("G1").Value
 ActiveSheet.PASTE
 
End Sub

 

[HighAndWilder]

Please can you advise.

The following code copies the selection on the worksheet Fine.
When i see it pasted its in cell A1 & the rows / columns are all squashed up.

Please can you advise how i can paste to the cell A10 & also keep row & column width / height values.

Thanks

Private Sub CommandButton100_Click()
 ActiveSheet.Range("F2:N61").Copy
 Sheets.Add(After:=Sheets(Sheets.Count)).NAME = Range("G1").Value
 ActiveSheet.PASTE
 
End Sub

Copy this into a standard code module.

Change the line as indicated.

Public Sub subCopyData()
Dim WsSource As Worksheet
Dim WsDestination As Worksheet
Dim rngSource As Range
Dim rngDestination As Range
Dim rng As Range
Dim i As Integer

  ' CHANGE THIS LINE TO INCLUDE YOUR SOURCE WORKSHEET NAME.
  Set WsSource = Worksheets("Source")
    
  ' Set object to source range.
  Set rngSource = WsSource.Range("F2:N61")
  
  ' Delete destination worksheet if it exists.
  Application.DisplayAlerts = False
  On Error Resume Next
  Worksheets(WsSource.Range("G1").Value).Delete
  On Error GoTo 0
  Application.DisplayAlerts = True
  
  ' Add a new worksheet and name after cell G1.
  Worksheets.Add(After:=Sheets(Sheets.Count)).Name = WsSource.Range("G1").Value
  
  ' Set object to Destination worksheet.
  Set WsDestination = ActiveSheet

  ' Set range object to destination range.
  Set rngDestination = WsDestination.Range("A10").Resize(rngSource.Rows.Count, rngSource.Columns.Count)

  ' Copy source range to A10 in destination worksheet.
  rngSource.Copy WsDestination.Range("A10")
  
  ' Loop through each row and column in the source range and change the
  ' corresponding row height and column width in the destination range.
  With rngDestination
    For i = 1 To rngSource.Rows.Count
      .Cells(i, 1).EntireRow.RowHeight = rngSource.Rows(i).RowHeight
    Next i
    For i = 1 To rngSource.Columns.Count
      .Cells(1, i).EntireColumn.ColumnWidth = rngSource.Columns(1).ColumnWidth
    Next i
  End With
  
End Sub

 

[ipbr21054]

Hi,
That allowed me to paste in cell A10 but the width / height properties didnt happen.

See the pasted content.

 

[ipbr21054]

I have just watched what happens.

The paste takes place & it looks say 75% shown BUT then i see it all start to squah up to the left then making it look say 25% ie screenshot shown above

 

[HighAndWilder]

I have just watched what happens.

The paste takes place & it looks say 75% shown BUT then i see it all start to squah up to the left then making it look say 25% ie screenshot shown above

What is the image doing in there?

 

[ipbr21054]

Image ?

The items that were copied from the first sheet then get pasted to the new sheet.
Its this i then watch get squashed up

 

[HighAndWilder]

You did not mention images.

 

[ipbr21054]

I didnt know it made any difference sorry.
Leave this now as having to re-think

 

[HighAndWilder]

I didnt know it made any difference sorry.
Leave this now as having to re-think

As long as we know what you have on the sheet I am sure that something is possible.

 

[HighAndWilder]

As long as we know what you have on the sheet I am sure that something is possible.

I noticed an error in the code.

This will not sort the image problem out but give it a go.

Public Sub subCopyData()
Dim WsSource As Worksheet
Dim WsDestination As Worksheet
Dim rngSource As Range
Dim rngDestination As Range
Dim rng As Range
Dim i As Integer

  ' CHANGE THIS LINE TO INCLUDE YOUR SOURCE WORKSHEET NAME.
  Set WsSource = Worksheets("Source")
    
  ' Set object to source range.
  Set rngSource = WsSource.Range("F2:N61")
  
  ' Delete destination worksheet if it exists.
  Application.DisplayAlerts = False
  On Error Resume Next
  Worksheets(WsSource.Range("G1").Value).Delete
  On Error GoTo 0
  Application.DisplayAlerts = True
  
  ' Add a new worksheet and name after cell G1.
  Worksheets.Add(After:=Sheets(Sheets.Count)).Name = WsSource.Range("G1").Value
  
  ' Set object to Destination worksheet.
  Set WsDestination = ActiveSheet

  ' Set range object to destination range.
  Set rngDestination = WsDestination.Range("A10").Resize(rngSource.Rows.Count, rngSource.Columns.Count)

  ' Copy source range to A10 in destination worksheet.
  rngSource.Copy WsDestination.Range("A10")
  
  ' Loop through each row and column in the source range and change the
  ' corresponding row height and column width in the destination range.
  With rngDestination
    
    For i = 1 To rngSource.Rows.Count
      .Cells(i, 1).EntireRow.RowHeight = rngSource.Rows(i).EntireRow.RowHeight
    Next i
        
    For i = 1 To rngSource.Columns.Count
      .Cells(1, i).EntireColumn.ColumnWidth = rngSource.Columns(i).EntireColumn.ColumnWidth
    Next i
     
  End With
    
End Sub