VBA to copy and paste information from c4:c25 in worksheet to specific tabs based on C4

Copper Contributor

Hi

1. I have previously managed to copy and paste cells from one worksheet (named: Form) to another Worksheet (selected in Cell C4). I have managed to get it to copy the column into a row on the correct sheet, but I can't get it to go to the next available line.

2. I also want it to go to another tab, where all the data will be stored (in the same workbook, tab = "Data")

3. If one of the Cells (C28) = a specific word I want the data to also be copy and pasted into the tab i.e "B"

Any help would be much appreciated

 

 

 

 

 

 

 

 

Sub Copy_Data()
  Dim hh As Worksheet, exist As Boolean, h As Worksheet, sh As Worksheet
  Dim f As Range
  Set hh = Sheets("Form")
  
 If hh.Range("C4") = "" Then
    MsgBox "Enter Hospital", vbCritical
    Exit Sub
  End If
  
  If hh.Range("C5") = "" Then
    MsgBox "Enter Ward", vbCritical
    Exit Sub
  End If
  
  exist = False
  For Each h In Sheets
    If LCase(h.Name) = LCase(hh.Range("C4").Value) Then
      Set sh = h
      exist = True
      Exit For
    End If
    
  Next
  If exist = False Then
    MsgBox "The sheet does not exist", vbCritical
    Exit Sub
  End If
  
  Set f = sh.Range("A1").Find(hh.Range("C4").Value, , xlValues, xlWhole)
  If f Is Nothing Then
    MsgBox "This does not exist", vbCritical

  Else
    'Copy data to Site Sheet'
    'cell destination             cell origin
    sh.Cells(Rows.Count, 1, "A:T").Value = hh.Range("C5:C23").Value
   
 End If
 End Sub

 

 

 

 

 

 

 

 

4 Replies

@KStevens660 

Please test on a copy of your workbook:

Sub Copy_Data()
  Dim hh As Worksheet
  Dim sh As Worksheet
  Dim r As Long
  Dim f As Range

  Set hh = Sheets("Form")

  If hh.Range("C4") = "" Then
    MsgBox "Enter Hospital", vbCritical
    Exit Sub
  End If

  If hh.Range("C5") = "" Then
    MsgBox "Enter Ward", vbCritical
    Exit Sub
  End If

  On Error Resume Next
  Set sh = Sheets(CStr(hh.Range("C4").Value))
  On Error GoTo 0
  If sh Is Nothing Then
    MsgBox "The sheet does not exist", vbCritical
    Exit Sub
  End If

  Set f = sh.Range("A1").Find(hh.Range("C4").Value, , xlValues, xlWhole)
  If f Is Nothing Then
    MsgBox "This does not exist", vbCritical
  Else
    'Copy data to Site Sheet
    r = sh.UsedRange.Rows.Count + 1
    'cell destination                       cell origin
    sh.Range("A" & r).Resize(1, 19).Value = Application.Transpose(hh.Range("C5:C23").Value)
  End If

  Set sh = Sheets("Data")
  r = sh.UsedRange.Rows.Count + 1
  'cell destination                       cell origin
  sh.Range("A" & r).Resize(1, 19).Value = Application.Transpose(hh.Range("C5:C23").Value)

  If hh.Range("C28") = "a specific word" Then
    Set sh = Sheets("B")
    r = sh.UsedRange.Rows.Count + 1
    'cell destination                       cell origin
    sh.Range("A" & r).Resize(1, 19).Value = Application.Transpose(hh.Range("C5:C23").Value)
  End If
End Sub
Hi thank you for helping me with this, it still gives me an error on row 34.

@KStevens660 

The code works in a simple demo (attached). Do the ranges that you refer to contain merged cells?

Hi No there is no Merged Cells, I found out the was a hidden space in my tab name, thank you, I have managed to get it working now.