复制和粘贴范围内的仅已使用的单元格

Question

I would really appreciate a little help. I have two open Workbooks, one is used for calculations, second one for keeping records. I used to do everything manually, but then I discovered macros and VBA, but I am a beginner. I have managed to write a code, that works for me, but I would like to have it improved.

I set a range Y22:Y37 (Sheets have same name in both workbooks), which is not always populated with values completely, but I don't know how to change the code to copy only used cells in the range. I tried to use SkipBlanks:=True, but it didn't work.

Once I copy the range I activate the second workbook, find the first empty row and paste transposed values there (starting in column B on purpose). But again, I paste the whole range Y22:Y37, which is unnecessary I think. Plus I would like to have a bottom border under used cells after pasting them. In the Picture, you can see that meanwhile I managed to make bottom border, but I used entire row.

I somehow adjusted to my needs various codes I could find, but I know I have probably used many redundant parts of the code, but I hope someone can help me make it cleaner. Thank you very much in advance, even for reading this far. Pictures of workbooks are in links below.

Sub CopyVyuctovani()
Set TargetWB = Workbooks("Výdej.xlsm")
Set SourceWB = Workbooks("DPV.xlsm")
TargetSH = ActiveSheet.Name
SourceWB.Sheets(TargetSH).Range("Y22:Y37").Copy
TargetWB.Sheets(TargetSH).Activate
lMaxRows = Cells(Rows.Count, "B").End(xlUp).Row
Range("B" & lMaxRows + 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Range("A" & lMaxRows + 1).Value = SourceWB.Sheets("Souhrn").Range("E30").Value
Application.CutCopyMode = False
Range("A" & Rows.Count).End(xlUp).EntireRow.Font.Color = RGB(255, 0, 0)
Range("A" & Rows.Count).End(xlUp).EntireRow.Borders(xlEdgeBottom).LineStyle = xlContinuous
End Sub

Source Workbook

Target Workbook

Answer 1

The code is more or less the same but it will fix your two problems

Sub CopyVyuctovani()

    Dim targetWB As Workbook
    Dim sourceWb As Workbook
    Dim targetSH As String
    Dim lmaxrows As Long

    Set targetWB = Workbooks("Výdej.xlsm")
    Set sourceWb = Workbooks("DPV.xlsm")
    targetSH = ActiveSheet.Name

    sourceWb.Sheets(targetSH).Range("Y22:Y37").Copy

    With targetWB.Sheets(targetSH)
        lmaxrows = Cells(Rows.Count, "B").End(xlUp).Row
        .Range("B" & lmaxrows + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=True
        .Range("A" & lmaxrows + 1).Value = sourceWb.Sheets("Souhrn").Range("E30").Value
        Application.CutCopyMode = False
        .Range("A" & lmaxrows & ":Q" & lmaxrows).Font.Color = RGB(255, 0, 0)
        .Range("A" & lmaxrows & ":Q" & lmaxrows).Borders(xlEdgeBottom).LineStyle = xlContinuous
    End With

End Sub

Answer 2

@Imran Malek

thank you, with this one I get no error, great :) But somehow, the copied range is pasted into line 38 of target WB (maybe it uses the last row 37 in source wb?) so I tried to activate the target WB first and it seems it works. Then I had a problem with formatting, with your code the format was used on a row that is exactly above the pasted one. So I added +1 to 1maxrows and it looks good now. The code looks like this now.

Sub CopyVyuctovani()

Dim targetWB As Workbook
Dim sourceWb As Workbook
Dim targetSH As String
Dim lmaxrows As Long

Set targetWB = Workbooks("Výdej.xlsm")
Set sourceWb = Workbooks("DPV.xlsm")
targetSH = ActiveSheet.Name

sourceWb.Sheets(targetSH).Range("Y22:Y37").Copy

With targetWB.Sheets(targetSH)
    .Activate
    lmaxrows = Cells(Rows.Count, "B").End(xlUp).Row
    .Range("B" & lmaxrows + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=True
    .Range("A" & lmaxrows + 1).Value = sourceWb.Sheets("Souhrn").Range("E30").Value
    Application.CutCopyMode = False
    .Range("A" & lmaxrows + 1 & ":Q" & lmaxrows + 1).Font.Color = RGB(255, 0, 0)
    .Range("A" & lmaxrows + 1 & ":Q" & lmaxrows + 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
End With
End Sub