Forum Discussion
VBA to copy and paste information from c4:c25 in worksheet to specific tabs based on C4
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
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.
The code works in a simple demo (attached). Do the ranges that you refer to contain merged cells?
