Luis Diaz
asked on
VBA: copy Range dynamically by calling a function or a procedure v2
Hello experts,
I have the following procedure available at:
In order to copy range dinamically based on the folling configuration file:
The problem that I am facing is that the reported the destination range located in the destination sheet is not clear previously before performing the copy process. I would like to correct the procedure in order to clear previsouly the range reported Destination Sheet & Destination Letter and then performing the copy process.
Thank you again for your help.
I have the following procedure available at:
Sub CopyRangeDynamically()
Dim wsConfig As Worksheet, wsDestination As Worksheet, wsSourceSheet As Worksheet
Dim sSheetName As String, sSourceColumn As String, sSourceColumn2 As String, sDestinationColumn, sSheetName2 As String
Dim rgDestination As Range, rgSource As Range
Dim rw As Integer, MaxRowSourceSheet As Long
CheckConfigSheet
Set wsConfig = Worksheets("4.Parameter-Copy-Range")
Application.ScreenUpdating = False
For rw = 2 To wsConfig.Range("A1").CurrentRegion.Rows.Count
sSheetName = wsConfig.Range("A" & rw) '==Original Sheet Name
Set wsSourceSheet = Worksheets(sSheetName)
sSheetName2 = wsConfig.Range("D" & rw) '==Destination Sheet Name
Set wsDestination = Worksheets(sSheetName2)
MaxRowSourceSheet = wsSourceSheet.Cells.SpecialCells(xlCellTypeLastCell).Row '==Max Row Original Sheet
sSourceColumn = wsConfig.Range("B" & rw)
sSourceColumn2 = wsConfig.Range("C" & rw)
sDestinationColumn = wsConfig.Range("E" & rw)
sDestinationHeader = wsConfig.Range("F" & rw)
'MatchCount = 0
'wsSourceSheet.Select
Set rgSource = wsSourceSheet.Range(sSourceColumn & "2:" & sSourceColumn2 & MaxRowSourceSheet)
Set rgDestination = wsDestination.Range(sDestinationColumn & "2")
rgSource.Copy
rgDestination.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False ' to clear the clipboard
wsDestination.Range(sDestinationColumn & "1").Value = sDestinationHeader
Next
MsgBox "Process has been done", vbOKOnly 'just as an FYI to the user and pass back control
wsConfig.Select
End Sub
Sub CheckConfigSheet()
Dim wsConfig As Worksheet, ws As Worksheet, rw As Integer, col As Integer, i As Integer, WarningText As String
Set wsConfig = Worksheets("4.Parameter-Copy-Range")
For rw = 2 To wsConfig.Range("A1").CurrentRegion.Rows.Count
i = 0
For Each ws In Worksheets
If wsConfig.Range("A" & rw) <> "" Then
If UCase(ws.Name) = UCase(wsConfig.Range("A" & rw)) Then
i = i + 1
End If
If UCase(ws.Name) = UCase(wsConfig.Range("D" & rw)) Then
i = i + 1
End If
End If
Next ws
For col = 2 To 3
If wsConfig.Cells(rw, col) <> "" And Len(wsConfig.Cells(rw, col)) <= 2 Then
If WorksheetFunction.IsText(wsConfig.Cells(rw, col)) Then
i = i + 1
End If
End If
Next col
If wsConfig.Cells(rw, col) <> "" And Len(wsConfig.Cells(rw, col)) <= 2 Then
If WorksheetFunction.IsText(wsConfig.Cells(rw, 4)) Then
i = i + 1
End If
End If
'If wsConfig.Range("G" & rw) = 0 Or wsConfig.Range("G" & rw) = 1 Then
'i = i + 1
'End If
If i <> 4 Then
WarningText = "Warning" & Chr(10) & "Data entered in Config Sheet row " & CStr(rw) & " is not consistent, please check that:"
WarningText = WarningText & Chr(10) & "1-Sheets exist or there is a misspelled mistake or you haven't entered data."
WarningText = WarningText & Chr(10) & "2-Required columns entered in Range are alphabetical and not numeric."
WarningText = WarningText & Chr(10) & "3-Required flag value is not 0 or 1"
WarningText = WarningText & Chr(10) & Chr(10) & "Program stop"
MsgBox WarningText, vbCritical
End
End If
Next rw
End Sub
In order to copy range dinamically based on the folling configuration file:
The problem that I am facing is that the reported the destination range located in the destination sheet is not clear previously before performing the copy process. I would like to correct the procedure in order to clear previsouly the range reported Destination Sheet & Destination Letter and then performing the copy process.
Thank you again for your help.
ASKER
ASKER
@Rgonzo1971: sorry to disturb you. Could you please help me with this debug?
Thank you in advance for your help.
Thank you in advance for your help.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
It works, thank you again for your help!
You're welcome. Glad to help.
pls try
Open in new window