Witam,
Mam makro które pozwala mi skopiować dane z kilku plików excela do jednego.
Zależało mi na tym żeby kopiować tylko wybrane kolumny. Udało mi się to częściowo bo w tej chwili kopiuje dane zaczynając od kolumny "C".
Nie umiem sobie natomiast poradzić z pominięciem kolumn które znajdują się pośrodku, np kolumnę "E".
Będę wdzięczny za pomoc.
Private Sub CommandButton1_Click()
Dim przedstaw As Variant
Dim DoSkop As Workbook, Docel As Worksheet
Dim ostWiersz As Long, x As Integer
Dim ostDocel As Long, y As Long
Dim k As Long
Application.ScreenUpdating = False
Set Docel = ThisWorkbook.Worksheets("Arkusz1")
With Docel
ostDocel = .Cells(.Rows.Count, "A").End(xlUp).Row
If ostDocel > 2 Then
.Range("A2:L" & ostDocel).ClearContents
End If
End With
przedstaw = Application.GetOpenFilename(fileFilter:="Pliki Excel (*.xlsx),*.xlsx,", _
MultiSelect:=True)
k = 2
For x = LBound(przedstaw) To UBound(przedstaw)
Set DoSkop = Workbooks.Open(przedstaw(x))
With DoSkop.Worksheets("Arkusz1")
ostWiersz = .Cells(.Rows.Count, "A").End(xlUp).Row
For y = 2 To ostWiersz
.Range("C" & y & ":L" & y).Copy
Docel.Range("A" & k).PasteSpecial xlPasteValues
k = k + 1
Next y
End With
DoSkop.Close
Set DoSkop = Nothing
Next x
Set Docel = Nothing
Application.ScreenUpdating = True
End Sub
Zmieniając makro w taki jak poniżej sposób udało mi się powodować pominięcie kolumny, ale dane z drugiego przedziału wklejają się w dobrych kolumnach tylko że dopiero w wierszach poniżej wkopiowanych wcześniej.
With DoSkop.Worksheets("Arkusz1")
ostWiersz = .Cells(.Rows.Count, "A").End(xlUp).Row
For y = 2 To ostWiersz
.Range("C" & y & ":D" & y).Copy
Docel.Range("A" & k).PasteSpecial xlPasteValues
k = k + 1
Next y
End With
With DoSkop.Worksheets("Arkusz1")
ostWiersz = .Cells(.Rows.Count, "A").End(xlUp).Row
For y = 2 To ostWiersz
.Range("F" & y & ":L" & y).Copy
Docel.Range("C" & k).PasteSpecial xlPasteValues
k = k + 1
Next y
End With |
wstecz 1 dalej
otwarty rozpoczął: gerg83
postów: 4
